accelerate 0.14.0.0 → 0.15.0.0
raw patch · 37 files changed
+1907/−4895 lines, 37 filesdep +template-haskelldep ~basedep ~fclabelsdep ~hashablesetup-changed
Dependencies added: template-haskell
Dependency ranges changed: base, fclabels, hashable, hashtables, unordered-containers
Files
- Data/Array/Accelerate.hs +17/−16
- Data/Array/Accelerate/AST.hs +11/−10
- Data/Array/Accelerate/Analysis/Match.hs +1/−1
- Data/Array/Accelerate/Analysis/Shape.hs +2/−2
- Data/Array/Accelerate/Analysis/Stencil.hs +2/−1
- Data/Array/Accelerate/Analysis/Type.hs +2/−2
- Data/Array/Accelerate/Array/Data.hs +128/−178
- Data/Array/Accelerate/Array/Delayed.hs +0/−76
- Data/Array/Accelerate/Array/Representation.hs +10/−10
- Data/Array/Accelerate/Array/Sugar.hs +36/−11
- Data/Array/Accelerate/Data/Complex.hs +171/−0
- Data/Array/Accelerate/Debug.hs +2/−2
- Data/Array/Accelerate/Error.hs +165/−0
- Data/Array/Accelerate/Internal/Check.hs +0/−123
- Data/Array/Accelerate/Interpreter.hs +1032/−1157
- Data/Array/Accelerate/Language.hs +42/−15
- Data/Array/Accelerate/Prelude.hs +83/−52
- Data/Array/Accelerate/Pretty.hs +3/−2
- Data/Array/Accelerate/Pretty/Print.hs +4/−3
- Data/Array/Accelerate/Smart.hs +18/−16
- Data/Array/Accelerate/Trafo.hs +6/−4
- Data/Array/Accelerate/Trafo/Algebra.hs +1/−1
- Data/Array/Accelerate/Trafo/Base.hs +6/−7
- Data/Array/Accelerate/Trafo/Fusion.hs +34/−60
- Data/Array/Accelerate/Trafo/Rewrite.hs +1/−1
- Data/Array/Accelerate/Trafo/Sharing.hs +50/−26
- Data/Array/Accelerate/Trafo/Shrink.hs +3/−3
- Data/Array/Accelerate/Trafo/Simplify.hs +8/−8
- Data/Array/Accelerate/Trafo/Substitution.hs +6/−3
- Data/Array/Accelerate/Tuple.hs +3/−2
- Data/Array/Accelerate/Type.hs +11/−41
- INSTALL +0/−20
- Setup.hs +1/−18
- accelerate.buildinfo.in +0/−3
- accelerate.cabal +48/−51
- configure +0/−2943
- include/accelerate.h +0/−27
Data/Array/Accelerate.hs view
@@ -1,7 +1,9 @@ -- | -- Module : Data.Array.Accelerate--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell+-- [2013..2014] Robert Clifton-Everest -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -65,7 +67,7 @@ (L.!), (L.!!), P.the, -- *** Shape information- P.null, L.shape, L.size, L.shapeSize,+ P.null, P.length, L.shape, L.size, L.shapeSize, -- *** Extracting sub-arrays L.slice,@@ -181,22 +183,22 @@ -- -- In general an @Exp Int@ cannot be unlifted into an `Int`, because the -- actual number will not be available until a later stage of execution (e.g.- -- GPU execution, when `run` is called). Similarly an @Acc array@ can not be- -- unlifted to a vanilla `array`; should instead `run` the expression with a- -- specific backend to evaluate it.+ -- during GPU execution, when `run` is called). Similarly an @Acc array@ can+ -- not be unlifted to a vanilla `array`; you should instead `run` the+ -- expression with a specific backend to evaluate it. --- -- Lifting and unlift are also used to pack and unpack an expression into and- -- out of constructors such as tuples, respectively. Those expressions, at+ -- Lifting and unlifting are also used to pack and unpack an expression into+ -- and out of constructors such as tuples, respectively. Those expressions, at -- runtime, will become tuple dereferences. For example: -- -- > Exp (Z :. Int :. Int)- -- > -> unlift -> (Z :. Exp Int :. Exp Int)- -- > -> lift -> Exp (Z :. Int :. Int)+ -- > -> unlift :: (Z :. Exp Int :. Exp Int)+ -- > -> lift :: Exp (Z :. Int :. Int) -- > -> ... -- -- > Acc (Scalar Int, Vector Float)- -- > -> unlift -> (Acc (Scalar Int), Acc (Vector Float))- -- > -> lift -> Acc (Scalar Int, Vector Float)+ -- > -> unlift :: (Acc (Scalar Int), Acc (Vector Float))+ -- > -> lift :: Acc (Scalar Int, Vector Float) -- > -> ... -- P.Lift(..), P.Unlift(..), P.lift1, P.lift2, P.ilift1, P.ilift2,@@ -213,10 +215,10 @@ L.constant, -- *** Tuples- P.fst, P.snd, P.curry, P.uncurry,+ P.fst, P.afst, P.snd, P.asnd, P.curry, P.uncurry, -- *** Flow control- (P.?), L.cond, L.while, P.iterate,+ (P.?), P.caseof, L.cond, L.while, P.iterate, -- *** Scalar reduction P.sfoldl,@@ -240,7 +242,7 @@ L.intersect, -- *** Conversions- L.boolToInt, L.fromIntegral,+ L.ord, L.chr, L.boolToInt, L.fromIntegral, -- --------------------------------------------------------------------------- @@ -273,7 +275,6 @@ -- system import Prelude (Float, Double, Bool, Char)-import qualified Prelude -- Renamings
Data/Array/Accelerate/AST.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}@@ -6,14 +5,17 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.AST--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell+-- [2010..2011] Ben Lever -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -100,14 +102,13 @@ import Data.Typeable -- friends+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Type import Data.Array.Accelerate.Tuple import Data.Array.Accelerate.Array.Representation ( SliceIndex ) import Data.Array.Accelerate.Array.Sugar as Sugar -#include "accelerate.h" - -- Typed de Bruijn indices -- ----------------------- @@ -138,7 +139,7 @@ Empty :: Val () Push :: Val env -> t -> Val (env, t) -deriving instance Typeable1 Val+deriving instance Typeable Val -- Valuation for an environment of array elements --@@ -152,14 +153,14 @@ prj :: Idx env t -> Val env -> t prj ZeroIdx (Push _ v) = v prj (SuccIdx idx) (Push val _) = prj idx val-prj _ _ = INTERNAL_ERROR(error) "prj" "inconsistent valuation"+prj _ _ = $internalError "prj" "inconsistent valuation" -- 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 (SuccIdx idx) (PushElt val _) = prjElt idx val-prjElt _ _ = INTERNAL_ERROR(error) "prjElt" "inconsistent valuation"+prjElt _ _ = $internalError "prjElt" "inconsistent valuation" -- Array expressions@@ -461,8 +462,8 @@ -- newtype OpenAcc aenv t = OpenAcc (PreOpenAcc OpenAcc aenv t) --- deriving instance Typeable3 PreOpenAcc-deriving instance Typeable2 OpenAcc+-- deriving instance Typeable PreOpenAcc+deriving instance Typeable OpenAcc -- |Closed array expression aka an array program --
Data/Array/Accelerate/Analysis/Match.hs view
@@ -7,7 +7,7 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Analysis.Match--- Copyright : [2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Analysis/Shape.hs view
@@ -4,8 +4,8 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Analysis.Shape--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Analysis/Stencil.hs view
@@ -4,7 +4,8 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.CUDA.Analysis.Stencil--- Copyright : [2010..2011] Ben Lever, Trevor L. McDonell+-- Copyright : [2010..2011] Ben Lever+-- [2010..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Analysis/Type.hs view
@@ -6,8 +6,8 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Analysis.Type--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Array/Data.hs view
@@ -1,18 +1,23 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnboxedTuples #-} {-# OPTIONS_GHC -fno-warn-missing-methods #-}+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Array.Data--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -32,50 +37,81 @@ ArrayEltR(..), GArrayData(..), -- * Array tuple operations- fstArrayData, sndArrayData, pairArrayData+ fstArrayData, sndArrayData, pairArrayData, + -- * Type macros+ HTYPE_INT, HTYPE_WORD, HTYPE_LONG, HTYPE_UNSIGNED_LONG, HTYPE_CCHAR,+ ) where -- standard libraries import Foreign (Ptr) import Foreign.C.Types-import GHC.Base (Int(..))-import GHC.Prim (newPinnedByteArray#, byteArrayContents#,- unsafeFreezeByteArray#, Int#, (*#))-import GHC.Ptr (Ptr(Ptr))-import GHC.ST (ST(ST))-import Data.Typeable+import Data.Bits import Data.Functor ((<$>))+import Data.Typeable (Typeable) import Control.Monad-import Control.Monad.ST-import qualified Data.Array.IArray as IArray #ifdef ACCELERATE_UNSAFE_CHECKS import qualified Data.Array.Base as MArray (readArray, writeArray) #else import qualified Data.Array.Base as MArray (unsafeRead, unsafeWrite)-import qualified Data.Array.Base as IArray (unsafeAt) #endif-import qualified Data.Array.Unsafe as Unsafe-import Data.Array.ST (STUArray)-import Data.Array.Unboxed (UArray)+import Data.Array.Storable.Internals+import Foreign.ForeignPtr.Unsafe+import System.IO.Unsafe import Data.Array.MArray (MArray)-import Data.Array.Base (UArray(UArray), STUArray(STUArray),- wORD_SCALE, fLOAT_SCALE, dOUBLE_SCALE)+import Data.Array.Base (unsafeNewArray_)+import Language.Haskell.TH -- friends import Data.Array.Accelerate.Type +-- Add needed Typeable instance for StorableArray+--+deriving instance Typeable StorableArray +-- Determine the underlying type of a Haskell CLong or CULong.+--+$( runQ [d| type HTYPE_INT = $(+ case finiteBitSize (undefined::Int) of+ 32 -> [t| Int32 |]+ 64 -> [t| Int64 |]+ _ -> error "I don't know what architecture I am" ) |] )++$( runQ [d| type HTYPE_WORD = $(+ case finiteBitSize (undefined::Word) of+ 32 -> [t| Word32 |]+ 64 -> [t| Word64 |]+ _ -> error "I don't know what architecture I am" ) |] )++$( runQ [d| type HTYPE_LONG = $(+ case finiteBitSize (undefined::CLong) of+ 32 -> [t| Int32 |]+ 64 -> [t| Int64 |]+ _ -> error "I don't know what architecture I am" ) |] )++$( runQ [d| type HTYPE_UNSIGNED_LONG = $(+ case finiteBitSize (undefined::CULong) of+ 32 -> [t| Word32 |]+ 64 -> [t| Word64 |]+ _ -> error "I don't know what architecture I am" ) |] )++$( runQ [d| type HTYPE_CCHAR = $(+ case isSigned (undefined::CChar) of+ True -> [t| Int8 |]+ False -> [t| Word8 |] ) |] )++ -- Array representation -- -------------------- -- |Immutable array representation ---type ArrayData e = GArrayData (UArray Int) e+type ArrayData e = MutableArrayData e -- |Mutable array representation ---type MutableArrayData s e = GArrayData (STUArray s Int) e+type MutableArrayData e = GArrayData (StorableArray Int) e -- Array representation in dependence on the element type, but abstracting -- over the basic array type (in particular, abstracting over mutability)@@ -106,15 +142,13 @@ data instance GArrayData ba CDouble = AD_CDouble (ba Double) data instance GArrayData ba Bool = AD_Bool (ba Word8) data instance GArrayData ba Char = AD_Char (ba Char)-data instance GArrayData ba CChar = AD_CChar (ba Int8)+data instance GArrayData ba CChar = AD_CChar (ba HTYPE_CCHAR) data instance GArrayData ba CSChar = AD_CSChar (ba Int8) data instance GArrayData ba CUChar = AD_CUChar (ba Word8) data instance GArrayData ba (a, b) = AD_Pair (GArrayData ba a) (GArrayData ba b) -instance (Typeable1 ba, Typeable e) => Typeable (GArrayData ba e) where- typeOf _ = myMkTyCon "Data.Array.Accelerate.Array.Data.GArrayData"- `mkTyConApp` [typeOf (undefined::ba e), typeOf (undefined::e)]+deriving instance Typeable GArrayData -- | GADT to reify the 'ArrayElt' class.@@ -163,11 +197,13 @@ unsafeIndexArrayData :: ArrayData e -> Int -> e ptrsOfArrayData :: ArrayData e -> ArrayPtrs e --- newArrayData :: Int -> ST s (MutableArrayData s e)- unsafeReadArrayData :: MutableArrayData s e -> Int -> ST s e- unsafeWriteArrayData :: MutableArrayData s e -> Int -> e -> ST s ()- unsafeFreezeArrayData :: MutableArrayData s e -> ST s (ArrayData e)- ptrsOfMutableArrayData :: MutableArrayData s e -> ST s (ArrayPtrs e)+ newArrayData :: Int -> IO (MutableArrayData e)+ unsafeReadArrayData :: MutableArrayData e -> Int -> IO e+ unsafeWriteArrayData :: MutableArrayData e -> Int -> e -> IO ()+ unsafeFreezeArrayData :: MutableArrayData e -> IO (ArrayData e)+ unsafeFreezeArrayData = return+ ptrsOfMutableArrayData :: MutableArrayData e -> IO (ArrayPtrs e)+ ptrsOfMutableArrayData = return . ptrsOfArrayData -- arrayElt :: ArrayEltR e @@ -178,260 +214,214 @@ newArrayData size = size `seq` return AD_Unit unsafeReadArrayData AD_Unit i = i `seq` return () unsafeWriteArrayData AD_Unit i () = i `seq` return ()- unsafeFreezeArrayData AD_Unit = return AD_Unit- ptrsOfMutableArrayData AD_Unit = return () arrayElt = ArrayEltRunit instance ArrayElt Int where type ArrayPtrs Int = Ptr Int unsafeIndexArrayData (AD_Int ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Int ba) = uArrayPtr ba- newArrayData size = liftM AD_Int $ unsafeNewArray_ size wORD_SCALE+ ptrsOfArrayData (AD_Int ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Int $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Int ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Int ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Int ba) = liftM AD_Int $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Int ba) = sTUArrayPtr ba arrayElt = ArrayEltRint instance ArrayElt Int8 where type ArrayPtrs Int8 = Ptr Int8 unsafeIndexArrayData (AD_Int8 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Int8 ba) = uArrayPtr ba- newArrayData size = liftM AD_Int8 $ unsafeNewArray_ size (\x -> x)+ ptrsOfArrayData (AD_Int8 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Int8 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Int8 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Int8 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Int8 ba) = liftM AD_Int8 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Int8 ba) = sTUArrayPtr ba arrayElt = ArrayEltRint8 instance ArrayElt Int16 where type ArrayPtrs Int16 = Ptr Int16 unsafeIndexArrayData (AD_Int16 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Int16 ba) = uArrayPtr ba- newArrayData size = liftM AD_Int16 $ unsafeNewArray_ size (*# 2#)+ ptrsOfArrayData (AD_Int16 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Int16 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Int16 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Int16 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Int16 ba) = liftM AD_Int16 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Int16 ba) = sTUArrayPtr ba arrayElt = ArrayEltRint16 instance ArrayElt Int32 where type ArrayPtrs Int32 = Ptr Int32 unsafeIndexArrayData (AD_Int32 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Int32 ba) = uArrayPtr ba- newArrayData size = liftM AD_Int32 $ unsafeNewArray_ size (*# 4#)+ ptrsOfArrayData (AD_Int32 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Int32 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Int32 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Int32 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Int32 ba) = liftM AD_Int32 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Int32 ba) = sTUArrayPtr ba arrayElt = ArrayEltRint32 instance ArrayElt Int64 where type ArrayPtrs Int64 = Ptr Int64 unsafeIndexArrayData (AD_Int64 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Int64 ba) = uArrayPtr ba- newArrayData size = liftM AD_Int64 $ unsafeNewArray_ size (*# 8#)+ ptrsOfArrayData (AD_Int64 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Int64 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Int64 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Int64 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Int64 ba) = liftM AD_Int64 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Int64 ba) = sTUArrayPtr ba arrayElt = ArrayEltRint64 instance ArrayElt Word where type ArrayPtrs Word = Ptr Word unsafeIndexArrayData (AD_Word ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Word ba) = uArrayPtr ba- newArrayData size = liftM AD_Word $ unsafeNewArray_ size wORD_SCALE+ ptrsOfArrayData (AD_Word ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Word $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Word ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Word ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Word ba) = liftM AD_Word $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Word ba) = sTUArrayPtr ba arrayElt = ArrayEltRword instance ArrayElt Word8 where type ArrayPtrs Word8 = Ptr Word8 unsafeIndexArrayData (AD_Word8 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Word8 ba) = uArrayPtr ba- newArrayData size = liftM AD_Word8 $ unsafeNewArray_ size (\x -> x)+ ptrsOfArrayData (AD_Word8 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Word8 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Word8 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Word8 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Word8 ba) = liftM AD_Word8 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Word8 ba) = sTUArrayPtr ba arrayElt = ArrayEltRword8 instance ArrayElt Word16 where type ArrayPtrs Word16 = Ptr Word16 unsafeIndexArrayData (AD_Word16 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Word16 ba) = uArrayPtr ba- newArrayData size = liftM AD_Word16 $ unsafeNewArray_ size (*# 2#)+ ptrsOfArrayData (AD_Word16 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Word16 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Word16 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Word16 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Word16 ba) = liftM AD_Word16 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Word16 ba) = sTUArrayPtr ba arrayElt = ArrayEltRword16 instance ArrayElt Word32 where type ArrayPtrs Word32 = Ptr Word32 unsafeIndexArrayData (AD_Word32 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Word32 ba) = uArrayPtr ba- newArrayData size = liftM AD_Word32 $ unsafeNewArray_ size (*# 4#)+ ptrsOfArrayData (AD_Word32 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Word32 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Word32 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Word32 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Word32 ba) = liftM AD_Word32 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Word32 ba) = sTUArrayPtr ba arrayElt = ArrayEltRword32 instance ArrayElt Word64 where type ArrayPtrs Word64 = Ptr Word64 unsafeIndexArrayData (AD_Word64 ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Word64 ba) = uArrayPtr ba- newArrayData size = liftM AD_Word64 $ unsafeNewArray_ size (*# 8#)+ ptrsOfArrayData (AD_Word64 ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Word64 $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Word64 ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Word64 ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Word64 ba) = liftM AD_Word64 $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Word64 ba) = sTUArrayPtr ba arrayElt = ArrayEltRword64 instance ArrayElt CShort where type ArrayPtrs CShort = Ptr Int16 unsafeIndexArrayData (AD_CShort ba) i = CShort $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CShort ba) = uArrayPtr ba- newArrayData size = liftM AD_CShort $ unsafeNewArray_ size (*# 2#)+ ptrsOfArrayData (AD_CShort ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CShort $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CShort ba) i = CShort <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CShort ba) i (CShort e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CShort ba) = liftM AD_CShort $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CShort ba) = sTUArrayPtr ba arrayElt = ArrayEltRcshort instance ArrayElt CUShort where type ArrayPtrs CUShort = Ptr Word16 unsafeIndexArrayData (AD_CUShort ba) i = CUShort $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CUShort ba) = uArrayPtr ba- newArrayData size = liftM AD_CUShort $ unsafeNewArray_ size (*# 2#)+ ptrsOfArrayData (AD_CUShort ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CUShort $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CUShort ba) i = CUShort <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CUShort ba) i (CUShort e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CUShort ba) = liftM AD_CUShort $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CUShort ba) = sTUArrayPtr ba arrayElt = ArrayEltRcushort instance ArrayElt CInt where type ArrayPtrs CInt = Ptr Int32 unsafeIndexArrayData (AD_CInt ba) i = CInt $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CInt ba) = uArrayPtr ba- newArrayData size = liftM AD_CInt $ unsafeNewArray_ size (*# 4#)+ ptrsOfArrayData (AD_CInt ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CInt $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CInt ba) i = CInt <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CInt ba) i (CInt e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CInt ba) = liftM AD_CInt $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CInt ba) = sTUArrayPtr ba arrayElt = ArrayEltRcint instance ArrayElt CUInt where type ArrayPtrs CUInt = Ptr Word32 unsafeIndexArrayData (AD_CUInt ba) i = CUInt $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CUInt ba) = uArrayPtr ba- newArrayData size = liftM AD_CUInt $ unsafeNewArray_ size (*# 4#)+ ptrsOfArrayData (AD_CUInt ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CUInt $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CUInt ba) i = CUInt <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CUInt ba) i (CUInt e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CUInt ba) = liftM AD_CUInt $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CUInt ba) = sTUArrayPtr ba arrayElt = ArrayEltRcuint instance ArrayElt CLong where type ArrayPtrs CLong = Ptr HTYPE_LONG unsafeIndexArrayData (AD_CLong ba) i = CLong $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CLong ba) = uArrayPtr ba- newArrayData size = liftM AD_CLong $ unsafeNewArray_ size wORD_SCALE+ ptrsOfArrayData (AD_CLong ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CLong $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CLong ba) i = CLong <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CLong ba) i (CLong e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CLong ba) = liftM AD_CLong $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CLong ba) = sTUArrayPtr ba arrayElt = ArrayEltRclong instance ArrayElt CULong where type ArrayPtrs CULong = Ptr HTYPE_UNSIGNED_LONG unsafeIndexArrayData (AD_CULong ba) i = CULong $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CULong ba) = uArrayPtr ba- newArrayData size = liftM AD_CULong $ unsafeNewArray_ size wORD_SCALE+ ptrsOfArrayData (AD_CULong ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CULong $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CULong ba) i = CULong <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CULong ba) i (CULong e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CULong ba) = liftM AD_CULong $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CULong ba) = sTUArrayPtr ba arrayElt = ArrayEltRculong instance ArrayElt CLLong where type ArrayPtrs CLLong = Ptr Int64 unsafeIndexArrayData (AD_CLLong ba) i = CLLong $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CLLong ba) = uArrayPtr ba- newArrayData size = liftM AD_CLLong $ unsafeNewArray_ size (*# 8#)+ ptrsOfArrayData (AD_CLLong ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CLLong $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CLLong ba) i = CLLong <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CLLong ba) i (CLLong e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CLLong ba) = liftM AD_CLLong $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CLLong ba) = sTUArrayPtr ba arrayElt = ArrayEltRcllong instance ArrayElt CULLong where type ArrayPtrs CULLong = Ptr Word64 unsafeIndexArrayData (AD_CULLong ba) i = CULLong $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CULLong ba) = uArrayPtr ba- newArrayData size = liftM AD_CULLong $ unsafeNewArray_ size (*# 8#)+ ptrsOfArrayData (AD_CULLong ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CULLong $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CULLong ba) i = CULLong <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CULLong ba) i (CULLong e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CULLong ba) = liftM AD_CULLong $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CULLong ba) = sTUArrayPtr ba arrayElt = ArrayEltRcullong instance ArrayElt Float where type ArrayPtrs Float = Ptr Float unsafeIndexArrayData (AD_Float ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Float ba) = uArrayPtr ba- newArrayData size = liftM AD_Float $ unsafeNewArray_ size fLOAT_SCALE+ ptrsOfArrayData (AD_Float ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Float $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Float ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Float ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Float ba) = liftM AD_Float $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Float ba) = sTUArrayPtr ba arrayElt = ArrayEltRfloat instance ArrayElt Double where type ArrayPtrs Double = Ptr Double unsafeIndexArrayData (AD_Double ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Double ba) = uArrayPtr ba- newArrayData size = liftM AD_Double $ unsafeNewArray_ size dOUBLE_SCALE+ ptrsOfArrayData (AD_Double ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Double $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Double ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Double ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Double ba) = liftM AD_Double $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Double ba) = sTUArrayPtr ba arrayElt = ArrayEltRdouble instance ArrayElt CFloat where type ArrayPtrs CFloat = Ptr Float unsafeIndexArrayData (AD_CFloat ba) i = CFloat $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CFloat ba) = uArrayPtr ba- newArrayData size = liftM AD_CFloat $ unsafeNewArray_ size fLOAT_SCALE+ ptrsOfArrayData (AD_CFloat ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CFloat $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CFloat ba) i = CFloat <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CFloat ba) i (CFloat e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CFloat ba) = liftM AD_CFloat $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CFloat ba) = sTUArrayPtr ba arrayElt = ArrayEltRcfloat instance ArrayElt CDouble where type ArrayPtrs CDouble = Ptr Double unsafeIndexArrayData (AD_CDouble ba) i = CDouble $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CDouble ba) = uArrayPtr ba- newArrayData size = liftM AD_CDouble $ unsafeNewArray_ size dOUBLE_SCALE+ ptrsOfArrayData (AD_CDouble ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CDouble $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CDouble ba) i = CDouble <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CDouble ba) i (CDouble e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CDouble ba) = liftM AD_CDouble $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CDouble ba) = sTUArrayPtr ba arrayElt = ArrayEltRcdouble -- Bool arrays are stored as arrays of bytes. While this is memory inefficient,@@ -442,12 +432,10 @@ instance ArrayElt Bool where type ArrayPtrs Bool = Ptr Word8 unsafeIndexArrayData (AD_Bool ba) i = toBool (unsafeIndexArray ba i)- ptrsOfArrayData (AD_Bool ba) = uArrayPtr ba- newArrayData size = liftM AD_Bool $ unsafeNewArray_ size (\x -> x)+ ptrsOfArrayData (AD_Bool ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Bool $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Bool ba) i = liftM toBool $ unsafeReadArray ba i unsafeWriteArrayData (AD_Bool ba) i e = unsafeWriteArray ba i (fromBool e)- unsafeFreezeArrayData (AD_Bool ba) = liftM AD_Bool $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Bool ba) = sTUArrayPtr ba arrayElt = ArrayEltRbool {-# INLINE toBool #-}@@ -466,48 +454,40 @@ instance ArrayElt Char where type ArrayPtrs Char = Ptr Char unsafeIndexArrayData (AD_Char ba) i = unsafeIndexArray ba i- ptrsOfArrayData (AD_Char ba) = uArrayPtr ba- newArrayData size = liftM AD_Char $ unsafeNewArray_ size (*# 4#)+ ptrsOfArrayData (AD_Char ba) = storableArrayPtr ba+ newArrayData size = liftM AD_Char $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_Char ba) i = unsafeReadArray ba i unsafeWriteArrayData (AD_Char ba) i e = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_Char ba) = liftM AD_Char $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_Char ba) = sTUArrayPtr ba arrayElt = ArrayEltRchar instance ArrayElt CChar where- type ArrayPtrs CChar = Ptr Int8+ type ArrayPtrs CChar = Ptr HTYPE_CCHAR unsafeIndexArrayData (AD_CChar ba) i = CChar $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CChar ba) = uArrayPtr ba- newArrayData size = liftM AD_CChar $ unsafeNewArray_ size (\x -> x)+ ptrsOfArrayData (AD_CChar ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CChar $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CChar ba) i = CChar <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CChar ba) i (CChar e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CChar ba) = liftM AD_CChar $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CChar ba) = sTUArrayPtr ba arrayElt = ArrayEltRcchar instance ArrayElt CSChar where type ArrayPtrs CSChar = Ptr Int8 unsafeIndexArrayData (AD_CSChar ba) i = CSChar $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CSChar ba) = uArrayPtr ba- newArrayData size = liftM AD_CSChar $ unsafeNewArray_ size (\x -> x)+ ptrsOfArrayData (AD_CSChar ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CSChar $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CSChar ba) i = CSChar <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CSChar ba) i (CSChar e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CSChar ba) = liftM AD_CSChar $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CSChar ba) = sTUArrayPtr ba arrayElt = ArrayEltRcschar instance ArrayElt CUChar where type ArrayPtrs CUChar = Ptr Word8 unsafeIndexArrayData (AD_CUChar ba) i = CUChar $ unsafeIndexArray ba i- ptrsOfArrayData (AD_CUChar ba) = uArrayPtr ba- newArrayData size = liftM AD_CUChar $ unsafeNewArray_ size (\x -> x)+ ptrsOfArrayData (AD_CUChar ba) = storableArrayPtr ba+ newArrayData size = liftM AD_CUChar $ unsafeNewArray_ (0,size-1) unsafeReadArrayData (AD_CUChar ba) i = CUChar <$> unsafeReadArray ba i unsafeWriteArrayData (AD_CUChar ba) i (CUChar e) = unsafeWriteArray ba i e- unsafeFreezeArrayData (AD_CUChar ba) = liftM AD_CUChar $ Unsafe.unsafeFreeze ba- ptrsOfMutableArrayData (AD_CUChar ba) = sTUArrayPtr ba arrayElt = ArrayEltRcuchar instance (ArrayElt a, ArrayElt b) => ArrayElt (a, b) where@@ -544,11 +524,10 @@ -- {-# INLINE runArrayData #-} runArrayData :: ArrayElt e- => (forall s. ST s (MutableArrayData s e, e)) -> (ArrayData e, e)-runArrayData st = runST $ do+ => IO (MutableArrayData e, e) -> (ArrayData e, e)+runArrayData st = unsafePerformIO $ do (mad, r) <- st- ad <- unsafeFreezeArrayData mad- return (ad, r)+ return (mad, r) -- Array tuple operations -- ----------------------@@ -574,13 +553,8 @@ -- linear indexing do bounds checking by default. -- {-# INLINE unsafeIndexArray #-}-unsafeIndexArray :: IArray.IArray UArray e => UArray Int e -> Int -> e-#ifdef ACCELERATE_UNSAFE_CHECKS-unsafeIndexArray = IArray.!-#else-unsafeIndexArray = IArray.unsafeAt-#endif-+unsafeIndexArray :: MArray a e IO => a Int e -> Int -> e+unsafeIndexArray a i = unsafePerformIO $ unsafeReadArray a i -- Read an element from a mutable array. --@@ -610,33 +584,9 @@ unsafeWriteArray = MArray.unsafeWrite #endif ---- Our own version of the 'STUArray' allocation that uses /pinned/ memory,--- which is aligned to 16 bytes.----{-# INLINE unsafeNewArray_ #-}-unsafeNewArray_ :: Int -> (Int# -> Int#) -> ST s (STUArray s Int e)-unsafeNewArray_ n@(I# n#) elemsToBytes- = ST $ \s1# ->- case newPinnedByteArray# (elemsToBytes n#) s1# of- (# s2#, marr# #) ->- (# s2#, STUArray 0 (n - 1) n marr# #)---- Obtains a pointer to the payload of an unboxed array.------ PRECONDITION: The unboxed array must be pinned.----{-# INLINE uArrayPtr #-}-uArrayPtr :: UArray Int a -> Ptr a-uArrayPtr (UArray _ _ _ ba) = Ptr (byteArrayContents# ba)---- Obtains a pointer to the payload of an unboxed ST array.------ PRECONDITION: The unboxed ST array must be pinned.+-- Obtains a pointer to the payload of an storable array. ---{-# INLINE sTUArrayPtr #-}-sTUArrayPtr :: STUArray s Int a -> ST s (Ptr a)-sTUArrayPtr (STUArray _ _ _ mba) = ST $ \s ->- case unsafeFreezeByteArray# mba s of- (# s', ba #) -> (# s', Ptr (byteArrayContents# ba) #)+{-# INLINE storableArrayPtr #-}+storableArrayPtr :: StorableArray i a -> Ptr a+storableArrayPtr (StorableArray _ _ _ fp) = unsafeForeignPtrToPtr fp
− Data/Array/Accelerate/Array/Delayed.hs
@@ -1,76 +0,0 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}--- |--- Module : Data.Array.Accelerate.Array.Delayed--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell--- License : BSD3------ Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>--- Stability : experimental--- Portability : non-portable (GHC extensions)------ Delayed arrays are represented by their representation function, which enables the simple--- composition of many array operations.-----module Data.Array.Accelerate.Array.Delayed (-- -- * Delayed array interface- Delayed, DelayedR(..), delay, force,--) where---- friends-import Data.Array.Accelerate.Array.Sugar---type Delayed a = DelayedR (ArrRepr a)---delay :: Arrays a => a -> Delayed a-delay arr = go (arrays arr) (fromArr arr)- where- go :: ArraysR a -> a -> DelayedR a- go ArraysRunit () = DelayedRunit- go ArraysRarray a = delayR a- go (ArraysRpair r1 r2) (a1, a2) = DelayedRpair (go r1 a1) (go r2 a2)---force :: forall a. Arrays a => Delayed a -> a-force arr = toArr $ go (arrays (undefined::a)) arr- where- go :: ArraysR a' -> DelayedR a' -> a'- go ArraysRunit DelayedRunit = ()- go ArraysRarray a = forceR a- go (ArraysRpair r1 r2) (DelayedRpair d1 d2) = (go r1 d1, go r2 d2)----- Delayed arrays are characterised by the domain of an array and its functional--- representation----class Delayable a where- data DelayedR a- delayR :: a -> DelayedR a- forceR :: DelayedR a -> a--instance Delayable () where- data DelayedR () = DelayedRunit- delayR () = DelayedRunit- forceR DelayedRunit = ()--instance Delayable (Array sh e) where- data DelayedR (Array sh e)- = (Shape sh, Elt e) =>- DelayedRarray { shapeDA :: EltRepr sh- , repfDA :: EltRepr sh -> EltRepr e- }- delayR arr@(Array sh _) = DelayedRarray sh (fromElt . (arr!) . toElt)- forceR (DelayedRarray sh f) = newArray (toElt sh) (toElt . f . fromElt)--instance (Delayable a1, Delayable a2) => Delayable (a1, a2) where- data DelayedR (a1, a2) = DelayedRpair (DelayedR a1) (DelayedR a2)- delayR (a1, a2) = DelayedRpair (delayR a1) (delayR a2)- forceR (DelayedRpair a1 a2) = (forceR a1, forceR a2)-
Data/Array/Accelerate/Array/Representation.hs view
@@ -1,15 +1,16 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Array.Representation--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -25,14 +26,13 @@ ) where -- friends+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Type -- standard library import GHC.Base ( quotInt, remInt ) -#include "accelerate.h" - -- |Index representation -- @@ -88,7 +88,7 @@ shapeToList () = [] listToShape [] = ()- listToShape _ = INTERNAL_ERROR(error) "listToShape" "non-empty list when converting to unit"+ listToShape _ = $internalError "listToShape" "non-empty list when converting to unit" instance Shape sh => Shape (sh, Int) where dim _ = dim (undefined :: sh) + 1@@ -96,7 +96,7 @@ (sh1, sz1) `intersect` (sh2, sz2) = (sh1 `intersect` sh2, sz1 `min` sz2) ignore = (ignore, -1)- toIndex (sh, sz) (ix, i) = BOUNDS_CHECK(checkIndex) "toIndex" i sz+ toIndex (sh, sz) (ix, i) = $indexCheck "toIndex" i sz $ toIndex sh ix * sz + i fromIndex (sh, sz) i = (fromIndex sh (i `quotInt` sz), r)@@ -104,7 +104,7 @@ -- the remainder for the highest dimension since i < sz must hold. -- where- r | dim sh == 0 = BOUNDS_CHECK(checkIndex) "fromIndex" i sz i+ r | dim sh == 0 = $indexCheck "fromIndex" i sz i | otherwise = i `remInt` sz bound (sh, sz) (ix, i) bndy@@ -128,7 +128,7 @@ iter' (ix,i) | i >= sz = r | otherwise = f (ix,i) `c` iter' (ix,i+1) - iter1 (_, 0) _ _ = BOUNDS_ERROR(error) "iter1" "empty iteration space"+ iter1 (_, 0) _ _ = $boundsError "iter1" "empty iteration space" iter1 (sh, sz) f c = iter1 sh (\ix -> iter1' (ix,0)) c where iter1' (ix,i) | i == sz-1 = f (ix,i)@@ -142,7 +142,7 @@ ((low, 0), (high, sz - 1)) shapeToList (sh,sz) = sz : shapeToList sh- listToShape [] = INTERNAL_ERROR(error) "listToShape" "empty list when converting to Ix"+ listToShape [] = $internalError "listToShape" "empty list when converting to Ix" listToShape (x:xs) = (listToShape xs,x)
Data/Array/Accelerate/Array/Sugar.hs view
@@ -12,9 +12,10 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Array.Sugar--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell--- [2013] Robert Clifton-Everest+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell+-- [2013..2014] Robert Clifton-Everest -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -53,6 +54,9 @@ import Data.Array.IArray ( IArray ) import qualified Data.Array.IArray as IArray +import GHC.Exts ( IsList )+import qualified GHC.Exts as GHC+ -- friends import Data.Array.Accelerate.Type import Data.Array.Accelerate.Array.Data@@ -82,10 +86,10 @@ -- | Marker for entire dimensions in slice descriptors. ----- For example, when used in slices passed to `replicate`, the--- occurrences of `All` indicate the dimensions into which the array's--- existing extent will be placed, rather than the new dimensions--- introduced by replication.+-- For example, when used in slices passed to `Data.Array.Accelerate.replicate`,+-- the occurrences of `All` indicate the dimensions into which the array's+-- existing extent will be placed, rather than the new dimensions introduced by+-- replication. -- data All = All deriving (Typeable, Show, Eq)@@ -663,9 +667,12 @@ {-# RULES "fromElt/toElt" forall e.- fromElt (toElt e) = e #-}+ fromElt (toElt e) = e +"toElt/fromElt" forall e.+ toElt (fromElt e) = e #-} + -- Foreign functions -- ----------------- @@ -673,7 +680,7 @@ -- By default it has no instances. If a backend wishes to have an FFI it must -- provide an instance. ---class Typeable2 f => Foreign (f :: * -> * -> *) where+class Typeable f => Foreign (f :: * -> * -> *) where -- Backends should be able to produce a string representation of the foreign -- function for pretty printing, typically the name of the function.@@ -822,7 +829,15 @@ fromArr (i, h, g, f, e, d, c, b, a) = (fromArr (i, h, g, f, e, d, c, b), fromArr' a) fromArr' (i, h, g, f, e, d, c, b, a) = (fromArr (i, h, g, f, e, d, c, b), fromArr' a) +{-# RULES +"fromArr/toArr" forall a.+ fromArr (toArr a) = a++"toArr/fromArr" forall a.+ toArr (fromArr a) = a #-}++ -- |Multi-dimensional arrays for array processing. -- -- If device and host memory are separate, arrays will be transferred to the@@ -835,7 +850,7 @@ -> ArrayData (EltRepr e) -- array payload -> Array sh e -deriving instance Typeable2 Array+deriving instance Typeable Array -- |Scalars arrays hold a single element --@@ -901,6 +916,9 @@ -- space; the index space is traversed in row-major order. iter :: sh -> (sh -> a) -> (a -> a -> a) -> a -> a + -- |Variant of 'iter' without an initial value+ iter1 :: sh -> (sh -> a) -> (a -> a -> a) -> a+ -- |Convert a minpoint-maxpoint index into a /shape/. rangeToShape :: (sh, sh) -> sh @@ -930,7 +948,8 @@ Left v -> Left v Right ix' -> Right $ toElt ix' - iter sh f c r = Repr.iter (fromElt sh) (f . toElt) c r+ iter sh f c r = Repr.iter (fromElt sh) (f . toElt) c r+ iter1 sh f r = Repr.iter1 (fromElt sh) (f . toElt) r rangeToShape (low, high) = toElt (Repr.rangeToShape (fromElt low, fromElt high))@@ -1085,6 +1104,12 @@ instance Show (Array sh e) where show arr@Array{} = "Array (" ++ showShape (shape arr) ++ ") " ++ show (toList arr)++instance Elt e => IsList (Vector e) where+ type Item (Vector e) = e+ toList = toList+ fromListN n xs = fromList (Z:.n) xs+ fromList xs = GHC.fromListN (length xs) xs {-- -- Specialised Show instances for dimensions zero, one, and two. Requires
+ Data/Array/Accelerate/Data/Complex.hs view
@@ -0,0 +1,171 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE IncoherentInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS -fno-warn-orphans #-}++module Data.Array.Accelerate.Data.Complex (++ -- * Rectangular from+ Complex(..),+ real,+ imag,++ -- * Polar form+ mkPolar,+ cis,+ polar,+ magnitude,+ phase,++ -- * Conjugate+ conjugate,++) where++import Prelude+import Data.Complex ( Complex(..) )+import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+++type instance EltRepr (Complex a) = (EltRepr a, EltRepr' a)+type instance EltRepr' (Complex a) = (EltRepr a, EltRepr' a)++instance Elt a => Elt (Complex a) where+ eltType (_::Complex a) = eltType (undefined :: (a,a))+ toElt (a,b) = toElt a :+ toElt' b+ fromElt (a :+ b) = (fromElt a, fromElt' b)++ eltType' (_::Complex a) = eltType' (undefined :: (a,a))+ toElt' (a,b) = toElt a :+ toElt' b+ fromElt' (a :+ b) = (fromElt a, fromElt' b)++instance IsTuple (Complex a) where+ type TupleRepr (Complex a) = (((), a), a)+ fromTuple (x :+ y) = (((), x), y)+ toTuple (((), x), y) = (x :+ y)++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Complex a) where+ type Plain (Complex a) = Complex (Plain a)+ lift (x1 :+ x2) = Exp $ Tuple (NilTup `SnocTup` lift x1 `SnocTup` lift x2)++instance Elt a => Unlift Exp (Complex (Exp a)) where+ unlift e+ = let x = Exp $ SuccTupIdx ZeroTupIdx `Prj` e+ y = Exp $ ZeroTupIdx `Prj` e+ in+ x :+ y++instance (Elt a, IsFloating a) => Num (Exp (Complex a)) where+ (+) = lift2 ((+) :: Complex (Exp a) -> Complex (Exp a) -> Complex (Exp a))+ (-) = lift2 ((-) :: Complex (Exp a) -> Complex (Exp a) -> Complex (Exp a))+ (*) = lift2 ((*) :: Complex (Exp a) -> Complex (Exp a) -> Complex (Exp a))+ negate = lift1 (negate :: Complex (Exp a) -> Complex (Exp a))+ signum = lift1 (signum :: Complex (Exp a) -> Complex (Exp a))+ abs = lift1 (abs :: Complex (Exp a) -> Complex (Exp a))+ fromInteger n = lift (constant (fromInteger n) :+ 0)+++instance (Elt a, IsFloating a) => Fractional (Exp (Complex a)) where+ c / c'+ = let x :+ y = unlift c+ x' :+ y' = unlift c' :: Complex (Exp a)+ den = x'^(2 :: Int) + y'^(2 :: Int)+ re = (x * x' + y * y') / den+ im = (y * x' - x * y') / den+ in+ lift (re :+ im)++ fromRational x+ = lift (constant (fromRational x) :+ constant 0)+++instance (Elt a, IsFloating a, RealFloat a) => Floating (Exp (Complex a)) where+ sqrt z+ = let+ x :+ y = unlift z+ v' = abs y / (u'*2)+ u' = sqrt ((magnitude z + abs x) / 2)+ (u, v) = unlift ( x <* 0 ? ( lift (v',u'), lift (u',v') ) )+ in+ x ==* 0 &&* y ==* 0 ?+ {- then -} ( 0+ {- else -} , lift (u :+ (y <* 0 ? (-v,v))) )++ pi = lift (pi :+ constant 0)+ log z = lift (log (magnitude z) :+ phase z)+ exp = lift1 (exp :: Complex (Exp a) -> Complex (Exp a))+ sin = lift1 (sin :: Complex (Exp a) -> Complex (Exp a))+ cos = lift1 (cos :: Complex (Exp a) -> Complex (Exp a))+ tan = lift1 (tan :: Complex (Exp a) -> Complex (Exp a))+ sinh = lift1 (sinh :: Complex (Exp a) -> Complex (Exp a))+ cosh = lift1 (cosh :: Complex (Exp a) -> Complex (Exp a))+ tanh = lift1 (tanh :: Complex (Exp a) -> Complex (Exp a))+ asin = lift1 (asin :: Complex (Exp a) -> Complex (Exp a))+ acos = lift1 (acos :: Complex (Exp a) -> Complex (Exp a))+ atan = lift1 (atan :: Complex (Exp a) -> Complex (Exp a))+ asinh = lift1 (asinh :: Complex (Exp a) -> Complex (Exp a))+ acosh = lift1 (acosh :: Complex (Exp a) -> Complex (Exp a))+ atanh = lift1 (atanh :: Complex (Exp a) -> Complex (Exp a))+++-- | The non-negative magnitude of a complex number+--+magnitude :: (Elt a, IsFloating a) => Exp (Complex a) -> Exp a+magnitude c =+ let r :+ i = unlift c+ in sqrt (r*r + i*i)++-- | The phase of a complex number, in the range @(-'pi', 'pi']@. If the+-- magnitude is zero, then so is the phase.+--+phase :: (Elt a, IsFloating a) => Exp (Complex a) -> Exp a+phase c =+ let x :+ y = unlift c+ in atan2 y x++-- | The function 'polar' takes a complex number and returns a (magnitude,+-- phase) pair in canonical form: the magnitude is non-negative, and the phase+-- in the range @(-'pi', 'pi']@; if the magnitude is zero, then so is the phase.+--+polar :: (Elt a, IsFloating a) => Exp (Complex a) -> Exp (a,a)+polar z = lift (magnitude z, phase z)++-- | Form a complex number from polar components of magnitude and phase.+--+mkPolar :: (Elt a, IsFloating a) => Exp a -> Exp a -> Exp (Complex a)+mkPolar r theta = lift $ r * cos theta :+ r * sin theta++-- | @'cis' t@ is a complex value with magnitude @1@ and phase @t@ (modulo+-- @2*'pi'@).+--+cis :: (Elt a, IsFloating a) => Exp a -> Exp (Complex a)+cis theta = lift $ cos theta :+ sin theta++-- | Return the real part of a complex number+--+real :: Elt a => Exp (Complex a) -> Exp a+real c =+ let r :+ _ = unlift c+ in r++-- | Return the imaginary part of a complex number+--+imag :: Elt a => Exp (Complex a) -> Exp a+imag c =+ let _ :+ i = unlift c+ in i++-- | Return the complex conjugate of a complex number, defined as+--+-- > conjugate(Z) = X - iY+--+conjugate :: (Elt a, IsNum a) => Exp (Complex a) -> Exp (Complex a)+conjugate z = lift $ real z :+ (- imag z)+
Data/Array/Accelerate/Debug.hs view
@@ -6,8 +6,8 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Debug--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
+ Data/Array/Accelerate/Error.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_HADDOCK hide #-}+-- |+-- Module : Data.Array.Accelerate.Error+-- Copyright : [2009..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--++module Data.Array.Accelerate.Error (++ internalError, boundsError, unsafeError,+ internalCheck, boundsCheck, unsafeCheck, indexCheck,+ internalWarning, boundsWarning, unsafeWarning,++) where++import Data.List+import Debug.Trace+import Language.Haskell.TH hiding ( Unsafe )++data Check = Bounds | Unsafe | Internal+ deriving (Eq)+++-- | Issue an internal error message+--+-- $internalError :: String -> String -> a+--+internalError :: Q Exp+internalError = appE errorQ [| Internal |]++boundsError :: Q Exp+boundsError = appE errorQ [| Bounds |]++unsafeError :: Q Exp+unsafeError = appE errorQ [| Unsafe |]+++-- | Throw an error if the condition evaluates to False, otherwise evaluate the+-- result.+--+-- $internalCheck :: String -> String -> Bool -> a -> a+--+internalCheck :: Q Exp+internalCheck = appE checkQ [| Internal |]++boundsCheck :: Q Exp+boundsCheck = appE checkQ [| Bounds |]++unsafeCheck :: Q Exp+unsafeCheck = appE checkQ [| Unsafe |]+++-- | Throw an error if the index is not in range, otherwise evaluate the result.+--+-- $boundsCheck :: String -> Int -> Int -> a -> a+--+indexCheck :: Q Exp+indexCheck = withLocation+ [| \format fn i n x ->+ if not (doChecks Bounds) || (i >= 0 && i < n)+ then x+ else error (format Bounds (call fn ("index out of bounds: " ++ show (i,n)))) x |]+++-- | Print a warning message if the condition evaluates to False.+--+-- $internalWarning :: String -> String -> Bool -> a -> a+--+internalWarning :: Q Exp+internalWarning = appE warningQ [| Internal |]++boundsWarning :: Q Exp+boundsWarning = appE warningQ [| Bounds |]++unsafeWarning :: Q Exp+unsafeWarning = appE warningQ [| Unsafe |]+++-- Template Haskell implementation+-- -------------------------------++call :: String -> String -> String+call f m = concat ["(", f, "): ", m]++errorQ :: Q Exp+errorQ = withLocation+ [| \format kind fn msg -> error (format kind (call fn msg)) |]++checkQ :: Q Exp+checkQ = withLocation+ [| \format kind fn msg cond x ->+ if not (doChecks kind) || cond+ then x+ else error (format kind (call fn msg)) |]++warningQ :: Q Exp+warningQ = withLocation+ [| \format kind fn msg cond x ->+ if not (doChecks kind) || cond+ then x+ else trace (format kind (call fn msg)) x |]++withLocation :: Q Exp -> Q Exp+withLocation f =+ appE f (locatedMessage =<< location)++locatedMessage :: Loc -> Q Exp+locatedMessage loc =+ [| \kind msg -> message kind ($(litE (stringL (formatLoc loc))) ++ msg) |]++formatLoc :: Loc -> String+formatLoc loc =+ let file = loc_filename loc+ (line,col) = loc_start loc+ in+ intercalate ":" [file, show line, show col, " "]++message :: Check -> String -> String+message kind msg = unlines header ++ msg+ where+ header = if kind == Internal+ then [""+ ,"*** Internal error in package accelerate ***"+ ,"*** Please submit a bug report at https://github.com/AccelerateHS/accelerate/issues"]+ else []+++-- CPP malarky+-- -----------++{-# INLINE doChecks #-}+doChecks :: Check -> Bool+doChecks Bounds = doBoundsChecks+doChecks Unsafe = doUnsafeChecks+doChecks Internal = doInternalChecks++doBoundsChecks :: Bool+#ifdef ACCELERATE_BOUNDS_CHECKS+doBoundsChecks = True+#else+doBoundsChecks = False+#endif++doUnsafeChecks :: Bool+#ifdef ACCELERATE_UNSAFE_CHECKS+doUnsafeChecks = True+#else+doUnsafeChecks = False+#endif++doInternalChecks :: Bool+#ifdef ACCELERATE_INTERNAL_CHECKS+doInternalChecks = True+#else+doInternalChecks = False+#endif+
− Data/Array/Accelerate/Internal/Check.hs
@@ -1,123 +0,0 @@-{-# LANGUAGE CPP #-}--- |--- Module : Data.Array.Accelerate.Internal.Check--- Copyright : [2009..2011] Roman Lechinskiy, Trevor L. McDonell--- License : BSD3------ Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>--- Stability : experimental--- Portability : non-portable (GHC extensions)------ Bounds checking infrastructure------ Stolen from the Vector package by Roman Leshchinskiy. This code has a--- BSD-style license. <http://hackage.haskell.org/package/vector>-----module Data.Array.Accelerate.Internal.Check (-- -- * Bounds checking and assertion infrastructure- Checks(..), doChecks,- error, check, warning, assert, checkIndex, checkLength, checkSlice--) where--import Prelude hiding ( error )-import Debug.Trace-import qualified Prelude as P--data Checks = Bounds | Unsafe | Internal deriving( Eq )--doBoundsChecks :: Bool-#ifdef ACCELERATE_BOUNDS_CHECKS-doBoundsChecks = True-#else-doBoundsChecks = False-#endif--doUnsafeChecks :: Bool-#ifdef ACCELERATE_UNSAFE_CHECKS-doUnsafeChecks = True-#else-doUnsafeChecks = False-#endif--doInternalChecks :: Bool-#ifdef ACCELERATE_INTERNAL_CHECKS-doInternalChecks = True-#else-doInternalChecks = False-#endif---doChecks :: Checks -> Bool-{-# INLINE doChecks #-}-doChecks Bounds = doBoundsChecks-doChecks Unsafe = doUnsafeChecks-doChecks Internal = doInternalChecks--message :: String -> Int -> Checks -> String -> String -> String-{-# INLINE message #-}-message file line kind loc msg- = unlines- $ (if kind == Internal- then ([""- ,"*** Internal error in package accelerate ***"- ,"*** Please submit a bug report at https://github.com/AccelerateHS/accelerate/issues"]++)- else id)- [ file ++ ":" ++ show line ++ " (" ++ loc ++ "): " ++ msg ]--error :: String -> Int -> Checks -> String -> String -> a-{-# INLINE error #-}-error file line kind loc msg- = P.error (message file line kind loc msg)--check :: String -> Int -> Checks -> String -> String -> Bool -> a -> a-{-# INLINE check #-}-check file line kind loc msg cond x- | not (doChecks kind) || cond = x- | otherwise = error file line kind loc msg--warning :: String -> Int -> Checks -> String -> String -> Bool -> a -> a-{-# INLINE warning #-}-warning file line kind loc msg cond x- | not (doChecks kind) || cond = x- | otherwise = trace (message file line kind loc msg) x--assert_msg :: String-assert_msg = "assertion failure"--assert :: String -> Int -> Checks -> String -> Bool -> a -> a-{-# INLINE assert #-}-assert file line kind loc = check file line kind loc assert_msg--checkIndex_msg :: Int -> Int -> String-{-# NOINLINE checkIndex_msg #-}-checkIndex_msg i n = "index out of bounds " ++ show (i,n)--checkIndex :: String -> Int -> Checks -> String -> Int -> Int -> a -> a-{-# INLINE checkIndex #-}-checkIndex file line kind loc i n x- = check file line kind loc (checkIndex_msg i n) (i >= 0 && i<n) x---checkLength_msg :: Int -> String-{-# NOINLINE checkLength_msg #-}-checkLength_msg n = "negative length " ++ show n--checkLength :: String -> Int -> Checks -> String -> Int -> a -> a-{-# INLINE checkLength #-}-checkLength file line kind loc n x- = check file line kind loc (checkLength_msg n) (n >= 0) x---checkSlice_msg :: Int -> Int -> Int -> String-{-# NOINLINE checkSlice_msg #-}-checkSlice_msg i m n = "invalid slice " ++ show (i,m,n)--checkSlice :: String -> Int -> Checks -> String -> Int -> Int -> Int -> a -> a-{-# INLINE checkSlice #-}-checkSlice file line kind loc i m n x- = check file line kind loc (checkSlice_msg i m n)- (i >= 0 && m >= 0 && i+m <= n) x-
Data/Array/Accelerate/Interpreter.hs view
@@ -1,1159 +1,1034 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# OPTIONS_HADDOCK prune #-}--- |--- Module : Data.Array.Accelerate.Interpreter--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell--- License : BSD3------ Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>--- Stability : experimental--- Portability : non-portable (GHC extensions)------ This interpreter is meant to be a reference implementation of the semantics--- of the embedded array language. The emphasis is on defining the semantics--- clearly, not on performance.------ /Surface types versus representation types/------ As a general rule, we perform all computations on representation types and we store all data--- as values of representation types. To guarantee the type safety of the interpreter, this--- currently implies a lot of conversions between surface and representation types. Optimising--- the code by eliminating back and forth conversions is fine, but only where it doesn't--- negatively affects clarity — after all, the main purpose of the interpreter is to serve as an--- executable specification.-----module Data.Array.Accelerate.Interpreter (-- -- * Interpret an array expression- Arrays, run, run1, stream,-- -- Internal (hidden)- evalPrim, evalPrimConst, evalPrj--) where---- standard libraries-import Control.Monad-import Control.Monad.ST ( ST )-import Data.Bits-import Data.Char ( chr, ord )-import Prelude hiding ( sum )---- friends-import Data.Array.Accelerate.Type-import Data.Array.Accelerate.Array.Data-import Data.Array.Accelerate.Array.Delayed-import Data.Array.Accelerate.Array.Representation hiding ( sliceIndex )-import Data.Array.Accelerate.Array.Sugar (- Z(..), (:.)(..), Array(..), Arrays, Scalar, Vector, Segments )-import Data.Array.Accelerate.AST-import Data.Array.Accelerate.Tuple-import Data.Array.Accelerate.Trafo.Substitution-import qualified Data.Array.Accelerate.Trafo.Sharing as Sharing-import qualified Data.Array.Accelerate.Smart as Sugar-import qualified Data.Array.Accelerate.Array.Sugar as Sugar--#include "accelerate.h"----- Program execution--- --------------------- | Run a complete embedded array program using the reference interpreter.----run :: Arrays a => Sugar.Acc a -> a-run = force . evalAcc . Sharing.convertAcc True True True----- | Prepare and run an embedded array program of one argument----run1 :: (Arrays a, Arrays b) => (Sugar.Acc a -> Sugar.Acc b) -> a -> b-run1 = run'----- | Prepare an n-ary embedded array program for execution, returning an n-ary--- closure to do so.----run' :: Sharing.Afunction f => f -> Sharing.AfunctionR f-run' afun = let acc = Sharing.convertAfun True True True afun- in evalOpenAfun acc Empty----- | Stream a lazily read list of input arrays through the given program,--- collecting results as we go----stream :: (Arrays a, Arrays b) => (Sugar.Acc a -> Sugar.Acc b) -> [a] -> [b]-stream afun arrs = let go = run1 afun- in map go arrs----- Array expression evaluation--- ------------------------------- Evaluate an open array function----evalOpenAfun :: OpenAfun aenv f -> Val aenv -> f-evalOpenAfun (Alam f) aenv = \a -> evalOpenAfun f (aenv `Push` a)-evalOpenAfun (Abody b) aenv = force $ evalOpenAcc b aenv----- Evaluate an open array expression----evalOpenAcc :: OpenAcc aenv a -> Val aenv -> Delayed a-evalOpenAcc (OpenAcc acc) = evalPreOpenAcc acc--evalPreOpenAcc :: forall aenv a. PreOpenAcc OpenAcc aenv a -> Val aenv -> Delayed a--evalPreOpenAcc (Alet acc1 acc2) aenv- = let !arr1 = force $ evalOpenAcc acc1 aenv- in evalOpenAcc acc2 (aenv `Push` arr1)--evalPreOpenAcc (Avar idx) aenv = delay $ prj idx aenv--evalPreOpenAcc (Atuple tup) aenv = delay (toTuple $ evalAtuple tup aenv :: a)--evalPreOpenAcc (Aprj ix (tup :: OpenAcc aenv arrs)) aenv =- let tup' = force $ evalOpenAcc tup aenv :: arrs- in delay $ evalPrj ix (fromTuple tup')--evalPreOpenAcc (Apply f acc) aenv =- let !arr = force $ evalOpenAcc acc aenv- in delay $ evalOpenAfun f aenv arr--evalPreOpenAcc (Acond cond acc1 acc2) aenv- = if (evalExp cond aenv) then evalOpenAcc acc1 aenv else evalOpenAcc acc2 aenv--evalPreOpenAcc (Awhile cond body acc) aenv- = let f = evalOpenAfun body aenv- p = evalOpenAfun cond aenv- go !x- | (p x) Sugar.! Z = go (f x)- | otherwise = delay x- in- go . force $ evalOpenAcc acc aenv--evalPreOpenAcc (Use arr) _aenv = delay (Sugar.toArr arr :: a)--evalPreOpenAcc (Unit e) aenv = unitOp (evalExp e aenv)--evalPreOpenAcc (Generate sh f) aenv- = generateOp (evalExp sh aenv) (evalFun f aenv)--evalPreOpenAcc (Transform sh ix f acc) aenv- = transformOp (evalExp sh aenv) (evalFun ix aenv) (evalFun f aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Reshape e acc) aenv- = reshapeOp (evalExp e aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Replicate sliceIndex slix acc) aenv- = replicateOp sliceIndex (evalExp slix aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Slice sliceIndex acc slix) aenv- = sliceOp sliceIndex (evalOpenAcc acc aenv) (evalExp slix aenv)--evalPreOpenAcc (Map f acc) aenv = mapOp (evalFun f aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (ZipWith f acc1 acc2) aenv- = zipWithOp (evalFun f aenv) (evalOpenAcc acc1 aenv) (evalOpenAcc acc2 aenv)--evalPreOpenAcc (Fold f e acc) aenv- = foldOp (evalFun f aenv) (evalExp e aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Fold1 f acc) aenv- = fold1Op (evalFun f aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (FoldSeg f e acc1 acc2) aenv- = foldSegOp integralType- (evalFun f aenv) (evalExp e aenv)- (evalOpenAcc acc1 aenv) (evalOpenAcc acc2 aenv)--evalPreOpenAcc (Fold1Seg f acc1 acc2) aenv- = fold1SegOp integralType- (evalFun f aenv) (evalOpenAcc acc1 aenv) (evalOpenAcc acc2 aenv)--evalPreOpenAcc (Scanl f e acc) aenv- = scanlOp (evalFun f aenv) (evalExp e aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Scanl' f e acc) aenv- = scanl'Op (evalFun f aenv) (evalExp e aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Scanl1 f acc) aenv- = scanl1Op (evalFun f aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Scanr f e acc) aenv- = scanrOp (evalFun f aenv) (evalExp e aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Scanr' f e acc) aenv- = scanr'Op (evalFun f aenv) (evalExp e aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Scanr1 f acc) aenv- = scanr1Op (evalFun f aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Permute f dftAcc p acc) aenv- = permuteOp (evalFun f aenv) (evalOpenAcc dftAcc aenv)- (evalFun p aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Backpermute e p acc) aenv- = backpermuteOp (evalExp e aenv) (evalFun p aenv) (evalOpenAcc acc aenv)--evalPreOpenAcc (Stencil sten bndy acc) aenv- = stencilOp (evalFun sten aenv) bndy (evalOpenAcc acc aenv)--evalPreOpenAcc (Stencil2 sten bndy1 acc1 bndy2 acc2) aenv- = stencil2Op (evalFun sten aenv) bndy1 (evalOpenAcc acc1 aenv) bndy2 (evalOpenAcc acc2 aenv)---- The interpreter does not handle foreign functions so use the pure accelerate version-evalPreOpenAcc (Aforeign _ (Alam (Abody funAcc)) acc) aenv- = let !arr = force $ evalOpenAcc acc aenv- in evalOpenAcc funAcc (Empty `Push` arr)-evalPreOpenAcc (Aforeign _ _ _) _- = error "This case is not possible"---- Evaluate a closed array expressions----evalAcc :: Acc a -> Delayed a-evalAcc acc = evalOpenAcc acc Empty----- Array tuple construction and projection----evalAtuple :: Atuple (OpenAcc aenv) t -> Val aenv -> t-evalAtuple NilAtup _ = ()-evalAtuple (SnocAtup t a) aenv = (evalAtuple t aenv, force $ evalOpenAcc a aenv)----- Array primitives--- ------------------unitOp :: Sugar.Elt e => e -> Delayed (Scalar e)-unitOp e- = DelayedRpair DelayedRunit- $ DelayedRarray {shapeDA = (), repfDA = const (Sugar.fromElt e)}--generateOp :: (Sugar.Shape dim, Sugar.Elt e)- => dim- -> (dim -> e)- -> Delayed (Array dim e)-generateOp sh rf- = DelayedRpair DelayedRunit- $ DelayedRarray (Sugar.fromElt sh) (Sugar.sinkFromElt rf)--transformOp- :: (Sugar.Shape sh', Sugar.Elt b)- => sh'- -> (sh' -> sh)- -> (a -> b)- -> Delayed (Array sh a)- -> Delayed (Array sh' b)-transformOp sh' ix f (DelayedRpair DelayedRunit (DelayedRarray _sh rf))- = DelayedRpair DelayedRunit- $ DelayedRarray (Sugar.fromElt sh')- (Sugar.sinkFromElt f . rf . Sugar.sinkFromElt ix)---reshapeOp :: Sugar.Shape dim- => dim -> Delayed (Array dim' e) -> Delayed (Array dim e)-reshapeOp newShape darr@(DelayedRpair DelayedRunit (DelayedRarray {shapeDA = oldShape}))- = let Array _ adata = force darr- in- BOUNDS_CHECK(check) "reshape" "shape mismatch" (Sugar.size newShape == size oldShape)- $ delay $ Array (Sugar.fromElt newShape) adata--replicateOp :: (Sugar.Shape dim, Sugar.Elt slix)- => SliceIndex (Sugar.EltRepr slix)- (Sugar.EltRepr sl)- co- (Sugar.EltRepr dim)- -> slix- -> Delayed (Array sl e)- -> Delayed (Array dim e)-replicateOp sliceIndex slix (DelayedRpair DelayedRunit (DelayedRarray sh pf))- = DelayedRpair DelayedRunit (DelayedRarray sh' (pf . pf'))- where- (sh', pf') = extend sliceIndex (Sugar.fromElt slix) sh-- extend :: SliceIndex slix sl co dim- -> slix- -> sl- -> (dim, dim -> sl)- extend (SliceNil) () () = ((), const ())- extend (SliceAll sliceIdx) (slx, ()) (sl, sz)- = let (dim', f') = extend sliceIdx slx sl- in- ((dim', sz), \(ix, i) -> (f' ix, i))- extend (SliceFixed sliceIdx) (slx, sz) sl- = let (dim', f') = extend sliceIdx slx sl- in- ((dim', sz), \(ix, _) -> f' ix)--sliceOp :: (Sugar.Shape sl, Sugar.Elt slix)- => SliceIndex (Sugar.EltRepr slix)- (Sugar.EltRepr sl)- co- (Sugar.EltRepr dim)- -> Delayed (Array dim e)- -> slix- -> Delayed (Array sl e)-sliceOp sliceIndex (DelayedRpair DelayedRunit (DelayedRarray sh pf)) slix- = DelayedRpair DelayedRunit (DelayedRarray sh' (pf . pf'))- where- (sh', pf') = restrict sliceIndex (Sugar.fromElt slix) sh-- restrict :: SliceIndex slix sl co dim- -> slix- -> dim- -> (sl, sl -> dim)- restrict (SliceNil) () () = ((), const ())- restrict (SliceAll sliceIdx) (slx, ()) (sl, sz)- = let (sl', f') = restrict sliceIdx slx sl- in- ((sl', sz), \(ix, i) -> (f' ix, i))- restrict (SliceFixed sliceIdx) (slx, i) (sl, sz)- = let (sl', f') = restrict sliceIdx slx sl- in- BOUNDS_CHECK(checkIndex) "slice" i sz $ (sl', \ix -> (f' ix, i))--mapOp :: Sugar.Elt e'- => (e -> e')- -> Delayed (Array dim e)- -> Delayed (Array dim e')-mapOp f (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = DelayedRpair DelayedRunit- $ DelayedRarray sh (Sugar.sinkFromElt f . rf)--zipWithOp :: Sugar.Elt e3- => (e1 -> e2 -> e3)- -> Delayed (Array dim e1)- -> Delayed (Array dim e2)- -> Delayed (Array dim e3)-zipWithOp f (DelayedRpair DelayedRunit (DelayedRarray sh1 rf1)) (DelayedRpair DelayedRunit (DelayedRarray sh2 rf2))- = DelayedRpair DelayedRunit- $ DelayedRarray (sh1 `intersect` sh2)- (\ix -> (Sugar.sinkFromElt2 f) (rf1 ix) (rf2 ix))--foldOp :: Sugar.Shape dim- => (e -> e -> e)- -> e- -> Delayed (Array (dim:.Int) e)- -> Delayed (Array dim e)-foldOp f e (DelayedRpair DelayedRunit (DelayedRarray (sh, n) rf))- | size sh == 0- = DelayedRpair DelayedRunit- $ DelayedRarray (listToShape . map (max 1) . shapeToList $ sh)- (\_ -> Sugar.fromElt e)- --- | otherwise- = DelayedRpair DelayedRunit- $ DelayedRarray sh- (\ix -> iter ((), n) (\((), i) -> rf (ix, i)) (Sugar.sinkFromElt2 f) (Sugar.fromElt e))--fold1Op :: Sugar.Shape dim- => (e -> e -> e)- -> Delayed (Array (dim:.Int) e)- -> Delayed (Array dim e)-fold1Op f (DelayedRpair DelayedRunit (DelayedRarray (sh, n) rf))- = DelayedRpair DelayedRunit- $ DelayedRarray sh (\ix -> iter1 ((), n) (\((), i) -> rf (ix, i)) (Sugar.sinkFromElt2 f))--foldSegOp :: IntegralType i- -> (e -> e -> e)- -> e- -> Delayed (Array (dim:.Int) e)- -> Delayed (Segments i)- -> Delayed (Array (dim:.Int) e)-foldSegOp ty f e arr seg- | IntegralDict <- integralDict ty = foldSegOp' f e arr seg--foldSegOp' :: forall i e dim. Integral i- => (e -> e -> e)- -> e- -> Delayed (Array (dim:.Int) e)- -> Delayed (Segments i)- -> Delayed (Array (dim:.Int) e)-foldSegOp' f e (DelayedRpair DelayedRunit (DelayedRarray (sh, _n) rf)) seg@(DelayedRpair DelayedRunit (DelayedRarray shSeg rfSeg))- = delay arr- where- DelayedRpair (DelayedRpair DelayedRunit (DelayedRarray _shSeg rfStarts)) _ = scanl'Op (+) 0 seg- arr = Sugar.newArray (Sugar.toElt (sh, Sugar.toElt shSeg)) foldOne- --- foldOne :: dim:.Int -> e- foldOne ix = let- (ix', i) = Sugar.fromElt ix- start = fromIntegral ((Sugar.liftToElt rfStarts) i :: i)- len = fromIntegral ((Sugar.liftToElt rfSeg) i :: i)- in- fold ix' e start (start + len)-- fold :: Sugar.EltRepr dim -> e -> Int -> Int -> e- fold ix' !v j end- | j >= end = v- | otherwise = fold ix' (f v (Sugar.toElt . rf $ (ix', j))) (j + 1) end---fold1SegOp :: IntegralType i- -> (e -> e -> e)- -> Delayed (Array (dim:.Int) e)- -> Delayed (Segments i)- -> Delayed (Array (dim:.Int) e)-fold1SegOp ty f arr seg- | IntegralDict <- integralDict ty = fold1SegOp' f arr seg---fold1SegOp' :: forall i e dim. Integral i- => (e -> e -> e)- -> Delayed (Array (dim:.Int) e)- -> Delayed (Segments i)- -> Delayed (Array (dim:.Int) e)-fold1SegOp' f (DelayedRpair DelayedRunit (DelayedRarray (sh, _n) rf)) seg@(DelayedRpair DelayedRunit (DelayedRarray shSeg rfSeg))- = delay arr- where- DelayedRpair prefix _sum = scanl'Op (+) 0 seg- DelayedRpair DelayedRunit (DelayedRarray _shSeg rfStarts) = prefix- arr = Sugar.newArray (Sugar.toElt (sh, Sugar.toElt shSeg)) foldOne- --- foldOne :: dim:.Int -> e- foldOne ix = let- (ix', i) = Sugar.fromElt ix- start = fromIntegral ((Sugar.liftToElt rfStarts) i :: i)- len = fromIntegral ((Sugar.liftToElt rfSeg) i :: i)- in- if len == 0- then- BOUNDS_ERROR(error) "fold1Seg" "empty iteration space"- else- fold ix' (Sugar.toElt . rf $ (ix', start)) (start + 1) (start + len)-- fold :: Sugar.EltRepr dim -> e -> Int -> Int -> e- fold ix' !v j end- | j >= end = v- | otherwise = fold ix' (f v (Sugar.toElt . rf $ (ix', j))) (j + 1) end---scanlOp :: forall e. (e -> e -> e)- -> e- -> Delayed (Vector e)- -> Delayed (Vector e)-scanlOp f e (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = delay $ adata `seq` Array ((), n + 1) adata- where- n = size sh- f' = Sugar.sinkFromElt2 f- --- (adata, _) = runArrayData $ do- arr <- newArrayData (n + 1)- final <- traverse arr 0 (Sugar.fromElt e)- unsafeWriteArrayData arr n final- return (arr, undefined)-- traverse :: MutableArrayData s (Sugar.EltRepr e) -> Int -> (Sugar.EltRepr e) -> ST s (Sugar.EltRepr e)- traverse arr i v- | i >= n = return v- | otherwise = do- unsafeWriteArrayData arr i v- traverse arr (i + 1) (f' v (rf ((), i)))--scanl'Op :: forall e. (e -> e -> e)- -> e- -> Delayed (Vector e)- -> Delayed (Vector e, Scalar e)-scanl'Op f e (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = DelayedRpair (delay $ adata `seq` Array sh adata) final- where- n = size sh- f' = Sugar.sinkFromElt2 f- --- DelayedRpair DelayedRunit final = unitOp (Sugar.toElt asum)-- (adata, asum) = runArrayData $ do- arr <- newArrayData n- sum <- traverse arr 0 (Sugar.fromElt e)- return (arr, sum)-- traverse :: MutableArrayData s (Sugar.EltRepr e) -> Int -> (Sugar.EltRepr e) -> ST s (Sugar.EltRepr e)- traverse arr i v- | i >= n = return v- | otherwise = do- unsafeWriteArrayData arr i v- traverse arr (i + 1) (f' v (rf ((), i)))--scanl1Op :: forall e. (e -> e -> e)- -> Delayed (Vector e)- -> Delayed (Vector e)-scanl1Op f (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = delay $ adata `seq` Array sh adata- where- n = size sh- f' = Sugar.sinkFromElt2 f- --- (adata, _) = runArrayData $ do- arr <- newArrayData n- traverse arr 0 undefined- return (arr, undefined)-- traverse :: MutableArrayData s (Sugar.EltRepr e) -> Int -> (Sugar.EltRepr e) -> ST s ()- traverse arr i v- | i >= n = return ()- | i == 0 = do- let e = rf ((), i)- unsafeWriteArrayData arr i e- traverse arr (i + 1) e- | otherwise = do- let e = f' v (rf ((), i))- unsafeWriteArrayData arr i e- traverse arr (i + 1) e--scanrOp :: forall e. (e -> e -> e)- -> e- -> Delayed (Vector e)- -> Delayed (Vector e)-scanrOp f e (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = delay $ adata `seq` Array ((), n + 1) adata- where- n = size sh- f' = Sugar.sinkFromElt2 f- --- (adata, _) = runArrayData $ do- arr <- newArrayData (n + 1)- final <- traverse arr n (Sugar.fromElt e)- unsafeWriteArrayData arr 0 final- return (arr, undefined)-- traverse :: MutableArrayData s (Sugar.EltRepr e) -> Int -> (Sugar.EltRepr e) -> ST s (Sugar.EltRepr e)- traverse arr i v- | i == 0 = return v- | otherwise = do- unsafeWriteArrayData arr i v- traverse arr (i - 1) (f' v (rf ((), i-1)))--scanr'Op :: forall e. (e -> e -> e)- -> e- -> Delayed (Vector e)- -> Delayed (Vector e, Scalar e)-scanr'Op f e (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = DelayedRpair (delay $ adata `seq` Array sh adata) final- where- n = size sh- f' = Sugar.sinkFromElt2 f- --- DelayedRpair DelayedRunit final = unitOp (Sugar.toElt asum)-- (adata, asum) = runArrayData $ do- arr <- newArrayData n- sum <- traverse arr (n-1) (Sugar.fromElt e)- return (arr, sum)-- traverse :: MutableArrayData s (Sugar.EltRepr e) -> Int -> (Sugar.EltRepr e) -> ST s (Sugar.EltRepr e)- traverse arr i v- | i < 0 = return v- | otherwise = do- unsafeWriteArrayData arr i v- traverse arr (i - 1) (f' v (rf ((), i)))--scanr1Op :: forall e. (e -> e -> e)- -> Delayed (Vector e)- -> Delayed (Vector e)-scanr1Op f (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = delay $ adata `seq` Array sh adata- where- n = size sh- f' = Sugar.sinkFromElt2 f- --- (adata, _) = runArrayData $ do- arr <- newArrayData n- traverse arr (n - 1) undefined- return (arr, undefined)-- traverse :: MutableArrayData s (Sugar.EltRepr e) -> Int -> (Sugar.EltRepr e) -> ST s ()- traverse arr i v- | i < 0 = return ()- | i == (n - 1) = do- let e = rf ((), i)- unsafeWriteArrayData arr i e- traverse arr (i - 1) e- | otherwise = do- let e = f' v (rf ((), i))- unsafeWriteArrayData arr i e- traverse arr (i - 1) e--permuteOp :: (e -> e -> e)- -> Delayed (Array dim' e)- -> (dim -> dim')- -> Delayed (Array dim e)- -> Delayed (Array dim' e)-permuteOp f (DelayedRpair DelayedRunit (DelayedRarray dftsSh dftsPf))- p (DelayedRpair DelayedRunit (DelayedRarray sh pf))- = delay $ adata `seq` Array dftsSh adata- where- f' = Sugar.sinkFromElt2 f- --- (adata, _)- = runArrayData $ do-- -- new array in target dimension- arr <- newArrayData (size dftsSh)-- -- initialise it with the default values- let write ix = unsafeWriteArrayData arr (toIndex dftsSh ix) (dftsPf ix)- iter dftsSh write (>>) (return ())-- -- traverse the source dimension and project each element into- -- the target dimension (where it gets combined with the current- -- default)- let update ix = do- let target = (Sugar.sinkFromElt p) ix- unless (target == ignore) $ do- let i = toIndex dftsSh target- e <- unsafeReadArrayData arr i- unsafeWriteArrayData arr i (pf ix `f'` e)- iter sh update (>>) (return ())-- -- return the updated array- return (arr, undefined)--backpermuteOp :: Sugar.Shape dim'- => dim'- -> (dim' -> dim)- -> Delayed (Array dim e)- -> Delayed (Array dim' e)-backpermuteOp sh' p (DelayedRpair DelayedRunit (DelayedRarray _sh rf))- = DelayedRpair DelayedRunit- $ DelayedRarray (Sugar.fromElt sh') (rf . Sugar.sinkFromElt p)--stencilOp :: forall dim e e' stencil. (Sugar.Elt e, Sugar.Elt e', Stencil dim e stencil)- => (stencil -> e')- -> Boundary (Sugar.EltRepr e)- -> Delayed (Array dim e)- -> Delayed (Array dim e')-stencilOp sten bndy (DelayedRpair DelayedRunit (DelayedRarray sh rf))- = DelayedRpair DelayedRunit- $ DelayedRarray sh rf'- where- rf' = Sugar.sinkFromElt (sten . stencilAccess rfBounded)-- -- add a boundary to the source array as specified by the boundary condition- rfBounded :: dim -> e- rfBounded ix = Sugar.toElt $ case Sugar.bound (Sugar.toElt sh) ix bndy of- Left v -> v- Right ix' -> rf (Sugar.fromElt ix')--stencil2Op :: forall dim e1 e2 e' stencil1 stencil2.- (Sugar.Elt e1, Sugar.Elt e2, Sugar.Elt e',- Stencil dim e1 stencil1, Stencil dim e2 stencil2)- => (stencil1 -> stencil2 -> e')- -> Boundary (Sugar.EltRepr e1)- -> Delayed (Array dim e1)- -> Boundary (Sugar.EltRepr e2)- -> Delayed (Array dim e2)- -> Delayed (Array dim e')-stencil2Op sten bndy1 (DelayedRpair DelayedRunit (DelayedRarray sh1 rf1))- bndy2 (DelayedRpair DelayedRunit (DelayedRarray sh2 rf2))- = DelayedRpair DelayedRunit (DelayedRarray (sh1 `intersect` sh2) rf')- where- rf' = Sugar.sinkFromElt (\ix -> sten (stencilAccess rf1Bounded ix)- (stencilAccess rf2Bounded ix))-- -- add a boundary to the source arrays as specified by the boundary conditions- rf1Bounded :: dim -> e1- rf1Bounded ix = Sugar.toElt $ case Sugar.bound (Sugar.toElt sh1) ix bndy1 of- Left v -> v- Right ix' -> rf1 (Sugar.fromElt ix')-- rf2Bounded :: dim -> e2- rf2Bounded ix = Sugar.toElt $ case Sugar.bound (Sugar.toElt sh2) ix bndy2 of- Left v -> v- Right ix' -> rf2 (Sugar.fromElt ix')----- Expression evaluation--- ------------------------- Evaluate open function----evalOpenFun :: OpenFun env aenv t -> ValElt env -> Val aenv -> t-evalOpenFun (Body e) env aenv = evalOpenExp e env aenv-evalOpenFun (Lam f) env aenv- = \x -> evalOpenFun f (env `PushElt` Sugar.fromElt x) aenv---- Evaluate a closed function----evalFun :: Fun aenv t -> Val aenv -> t-evalFun f aenv = evalOpenFun f EmptyElt aenv---- Evaluate an open expression------ NB: The implementation of 'Index' and 'Shape' demonstrate clearly why--- array expressions must be hoisted out of scalar expressions before code--- execution. If these operations are in the body of a function that--- gets mapped over an array, the array argument would be forced many times--- leading to a large amount of wasteful recomputation.----evalOpenExp :: OpenExp env aenv a -> ValElt env -> Val aenv -> a--evalOpenExp (Let exp1 exp2) env aenv- = let !v1 = evalOpenExp exp1 env aenv- in evalOpenExp exp2 (env `PushElt` Sugar.fromElt v1) aenv--evalOpenExp (Var idx) env _- = prjElt idx env--evalOpenExp (Const c) _ _- = Sugar.toElt c--evalOpenExp (Tuple tup) env aenv- = toTuple $ evalTuple tup env aenv--evalOpenExp (Prj idx e) env aenv- = evalPrj idx (fromTuple $ evalOpenExp e env aenv)--evalOpenExp IndexNil _env _aenv- = Z--evalOpenExp (IndexCons sh i) env aenv- = evalOpenExp sh env aenv :. evalOpenExp i env aenv--evalOpenExp (IndexHead ix) env aenv- = case evalOpenExp ix env aenv of _:.h -> h--evalOpenExp (IndexTail ix) env aenv- = case evalOpenExp ix env aenv of t:._ -> t--evalOpenExp (IndexAny) _ _- = Sugar.Any--evalOpenExp (IndexSlice sliceIndex slix sh) env aenv- = Sugar.toElt- $ restrict sliceIndex (Sugar.fromElt $ evalOpenExp slix env aenv)- (Sugar.fromElt $ evalOpenExp sh env aenv)- where- restrict :: SliceIndex slix sl co sh -> slix -> sh -> sl- restrict SliceNil () () = ()- restrict (SliceAll sliceIdx) (slx, ()) (sl, sz)- = let sl' = restrict sliceIdx slx sl- in (sl', sz)- restrict (SliceFixed sliceIdx) (slx, _i) (sl, _sz)- = restrict sliceIdx slx sl--evalOpenExp (IndexFull sliceIndex slix sh) env aenv- = Sugar.toElt- $ extend sliceIndex (Sugar.fromElt $ evalOpenExp slix env aenv)- (Sugar.fromElt $ evalOpenExp sh env aenv)- where- extend :: SliceIndex slix sl co sh -> slix -> sl -> sh- extend SliceNil () () = ()- extend (SliceAll sliceIdx) (slx, ()) (sl, sz)- = let sh' = extend sliceIdx slx sl- in (sh', sz)- extend (SliceFixed sliceIdx) (slx, sz) sl- = let sh' = extend sliceIdx slx sl- in (sh', sz)--evalOpenExp (ToIndex sh ix) env aenv- = Sugar.toIndex (evalOpenExp sh env aenv) (evalOpenExp ix env aenv)--evalOpenExp (FromIndex sh ix) env aenv- = Sugar.fromIndex (evalOpenExp sh env aenv) (evalOpenExp ix env aenv)--evalOpenExp (Cond c t e) env aenv- = if evalOpenExp c env aenv- then evalOpenExp t env aenv- else evalOpenExp e env aenv--evalOpenExp (While cond body seed) env aenv- = let f = evalOpenFun body env aenv- p = evalOpenFun cond env aenv- go !x- | p x = go (f x)- | otherwise = x- in- go (evalOpenExp seed env aenv)--evalOpenExp (PrimConst c) _ _ = evalPrimConst c--evalOpenExp (PrimApp p arg) env aenv- = evalPrim p (evalOpenExp arg env aenv)--evalOpenExp (Index acc ix) env aenv- = case evalOpenAcc acc aenv of- DelayedRpair DelayedRunit (DelayedRarray sh pf) ->- let ix' = Sugar.fromElt $ evalOpenExp ix env aenv- in- toIndex sh ix' `seq` (Sugar.toElt $ pf ix')- -- FIXME: This is ugly, but (possibly) needed to- -- ensure bounds checking--evalOpenExp (LinearIndex acc i) env aenv- = case evalOpenAcc acc aenv of- DelayedRpair DelayedRunit (DelayedRarray sh pf) ->- let i' = evalOpenExp i env aenv- v = pf (fromIndex sh i')- in Sugar.toElt v--evalOpenExp (Shape acc) _ aenv- = case evalOpenAcc acc aenv of- DelayedRpair DelayedRunit (DelayedRarray sh _) -> Sugar.toElt sh--evalOpenExp (ShapeSize sh) env aenv- = Sugar.size (evalOpenExp sh env aenv)--evalOpenExp (Intersect sh1 sh2) env aenv- = Sugar.intersect (evalOpenExp sh1 env aenv) (evalOpenExp sh2 env aenv)--evalOpenExp (Foreign _ f e) env aenv- = evalOpenExp e' env aenv- where- wExp :: Idx ((),a) t -> Idx (env,a) t- wExp ZeroIdx = ZeroIdx- wExp _ = INTERNAL_ERROR(error) "wExp" "unreachable case"-- e' = case f of- (Lam (Body b)) -> Let e $ weakenEA rebuildOpenAcc undefined (weakenE wExp b)- _ -> INTERNAL_ERROR(error) "travE" "unreachable case"---- Evaluate a closed expression----evalExp :: Exp aenv t -> Val aenv -> t-evalExp e aenv = evalOpenExp e EmptyElt aenv----- Scalar primitives--- -------------------evalPrimConst :: PrimConst a -> a-evalPrimConst (PrimMinBound ty) = evalMinBound ty-evalPrimConst (PrimMaxBound ty) = evalMaxBound ty-evalPrimConst (PrimPi ty) = evalPi ty--evalPrim :: PrimFun p -> p-evalPrim (PrimAdd ty) = evalAdd ty-evalPrim (PrimSub ty) = evalSub ty-evalPrim (PrimMul ty) = evalMul ty-evalPrim (PrimNeg ty) = evalNeg ty-evalPrim (PrimAbs ty) = evalAbs ty-evalPrim (PrimSig ty) = evalSig ty-evalPrim (PrimQuot ty) = evalQuot ty-evalPrim (PrimRem ty) = evalRem ty-evalPrim (PrimIDiv ty) = evalIDiv ty-evalPrim (PrimMod ty) = evalMod ty-evalPrim (PrimBAnd ty) = evalBAnd ty-evalPrim (PrimBOr ty) = evalBOr ty-evalPrim (PrimBXor ty) = evalBXor ty-evalPrim (PrimBNot ty) = evalBNot ty-evalPrim (PrimBShiftL ty) = evalBShiftL ty-evalPrim (PrimBShiftR ty) = evalBShiftR ty-evalPrim (PrimBRotateL ty) = evalBRotateL ty-evalPrim (PrimBRotateR ty) = evalBRotateR ty-evalPrim (PrimFDiv ty) = evalFDiv ty-evalPrim (PrimRecip ty) = evalRecip ty-evalPrim (PrimSin ty) = evalSin ty-evalPrim (PrimCos ty) = evalCos ty-evalPrim (PrimTan ty) = evalTan ty-evalPrim (PrimAsin ty) = evalAsin ty-evalPrim (PrimAcos ty) = evalAcos ty-evalPrim (PrimAtan ty) = evalAtan ty-evalPrim (PrimAsinh ty) = evalAsinh ty-evalPrim (PrimAcosh ty) = evalAcosh ty-evalPrim (PrimAtanh ty) = evalAtanh ty-evalPrim (PrimExpFloating ty) = evalExpFloating ty-evalPrim (PrimSqrt ty) = evalSqrt ty-evalPrim (PrimLog ty) = evalLog ty-evalPrim (PrimFPow ty) = evalFPow ty-evalPrim (PrimLogBase ty) = evalLogBase ty-evalPrim (PrimTruncate ta tb) = evalTruncate ta tb-evalPrim (PrimRound ta tb) = evalRound ta tb-evalPrim (PrimFloor ta tb) = evalFloor ta tb-evalPrim (PrimCeiling ta tb) = evalCeiling ta tb-evalPrim (PrimAtan2 ty) = evalAtan2 ty-evalPrim (PrimLt ty) = evalLt ty-evalPrim (PrimGt ty) = evalGt ty-evalPrim (PrimLtEq ty) = evalLtEq ty-evalPrim (PrimGtEq ty) = evalGtEq ty-evalPrim (PrimEq ty) = evalEq ty-evalPrim (PrimNEq ty) = evalNEq ty-evalPrim (PrimMax ty) = evalMax ty-evalPrim (PrimMin ty) = evalMin ty-evalPrim PrimLAnd = evalLAnd-evalPrim PrimLOr = evalLOr-evalPrim PrimLNot = evalLNot-evalPrim PrimOrd = evalOrd-evalPrim PrimChr = evalChr-evalPrim PrimBoolToInt = evalBoolToInt-evalPrim (PrimFromIntegral ta tb) = evalFromIntegral ta tb----- Tuple construction and projection--- -----------------------------------evalTuple :: Tuple (OpenExp env aenv) t -> ValElt env -> Val aenv -> t-evalTuple NilTup _env _aenv = ()-evalTuple (tup `SnocTup` e) env aenv = (evalTuple tup env aenv, evalOpenExp e env aenv)--evalPrj :: TupleIdx t e -> t -> e-evalPrj ZeroTupIdx (!_, v) = v-evalPrj (SuccTupIdx idx) (tup, !_) = evalPrj idx tup- -- FIXME: Strictly speaking, we ought to force all components of a tuples;- -- not only those that we happen to encounter during the recursive- -- walk.----- Implementation of scalar primitives--- -------------------------------------evalLAnd :: (Bool, Bool) -> Bool-evalLAnd (!x, !y) = x && y--evalLOr :: (Bool, Bool) -> Bool-evalLOr (!x, !y) = x || y--evalLNot :: Bool -> Bool-evalLNot = not--evalOrd :: Char -> Int-evalOrd = ord--evalChr :: Int -> Char-evalChr = chr--evalBoolToInt :: Bool -> Int-evalBoolToInt = fromEnum--evalFromIntegral :: IntegralType a -> NumType b -> a -> b-evalFromIntegral ta (IntegralNumType tb)- | IntegralDict <- integralDict ta- , IntegralDict <- integralDict tb = fromIntegral-evalFromIntegral ta (FloatingNumType tb)- | IntegralDict <- integralDict ta- , FloatingDict <- floatingDict tb = fromIntegral----- Extract methods from reified dictionaries------- Constant methods of Bounded-----evalMinBound :: BoundedType a -> a-evalMinBound (IntegralBoundedType ty)- | IntegralDict <- integralDict ty = minBound-evalMinBound (NonNumBoundedType ty)- | NonNumDict <- nonNumDict ty = minBound--evalMaxBound :: BoundedType a -> a-evalMaxBound (IntegralBoundedType ty)- | IntegralDict <- integralDict ty = maxBound-evalMaxBound (NonNumBoundedType ty)- | NonNumDict <- nonNumDict ty = maxBound---- Constant method of floating-----evalPi :: FloatingType a -> a-evalPi ty | FloatingDict <- floatingDict ty = pi--evalSin :: FloatingType a -> (a -> a)-evalSin ty | FloatingDict <- floatingDict ty = sin--evalCos :: FloatingType a -> (a -> a)-evalCos ty | FloatingDict <- floatingDict ty = cos--evalTan :: FloatingType a -> (a -> a)-evalTan ty | FloatingDict <- floatingDict ty = tan--evalAsin :: FloatingType a -> (a -> a)-evalAsin ty | FloatingDict <- floatingDict ty = asin--evalAcos :: FloatingType a -> (a -> a)-evalAcos ty | FloatingDict <- floatingDict ty = acos--evalAtan :: FloatingType a -> (a -> a)-evalAtan ty | FloatingDict <- floatingDict ty = atan--evalAsinh :: FloatingType a -> (a -> a)-evalAsinh ty | FloatingDict <- floatingDict ty = asinh--evalAcosh :: FloatingType a -> (a -> a)-evalAcosh ty | FloatingDict <- floatingDict ty = acosh--evalAtanh :: FloatingType a -> (a -> a)-evalAtanh ty | FloatingDict <- floatingDict ty = atanh--evalExpFloating :: FloatingType a -> (a -> a)-evalExpFloating ty | FloatingDict <- floatingDict ty = exp--evalSqrt :: FloatingType a -> (a -> a)-evalSqrt ty | FloatingDict <- floatingDict ty = sqrt--evalLog :: FloatingType a -> (a -> a)-evalLog ty | FloatingDict <- floatingDict ty = log--evalFPow :: FloatingType a -> ((a, a) -> a)-evalFPow ty | FloatingDict <- floatingDict ty = uncurry (**)--evalLogBase :: FloatingType a -> ((a, a) -> a)-evalLogBase ty | FloatingDict <- floatingDict ty = uncurry logBase--evalTruncate :: FloatingType a -> IntegralType b -> (a -> b)-evalTruncate ta tb- | FloatingDict <- floatingDict ta- , IntegralDict <- integralDict tb = truncate--evalRound :: FloatingType a -> IntegralType b -> (a -> b)-evalRound ta tb- | FloatingDict <- floatingDict ta- , IntegralDict <- integralDict tb = round--evalFloor :: FloatingType a -> IntegralType b -> (a -> b)-evalFloor ta tb- | FloatingDict <- floatingDict ta- , IntegralDict <- integralDict tb = floor--evalCeiling :: FloatingType a -> IntegralType b -> (a -> b)-evalCeiling ta tb- | FloatingDict <- floatingDict ta- , IntegralDict <- integralDict tb = ceiling--evalAtan2 :: FloatingType a -> ((a, a) -> a)-evalAtan2 ty | FloatingDict <- floatingDict ty = uncurry atan2----- Methods of Num-----evalAdd :: NumType a -> ((a, a) -> a)-evalAdd (IntegralNumType ty) | IntegralDict <- integralDict ty = uncurry (+)-evalAdd (FloatingNumType ty) | FloatingDict <- floatingDict ty = uncurry (+)--evalSub :: NumType a -> ((a, a) -> a)-evalSub (IntegralNumType ty) | IntegralDict <- integralDict ty = uncurry (-)-evalSub (FloatingNumType ty) | FloatingDict <- floatingDict ty = uncurry (-)--evalMul :: NumType a -> ((a, a) -> a)-evalMul (IntegralNumType ty) | IntegralDict <- integralDict ty = uncurry (*)-evalMul (FloatingNumType ty) | FloatingDict <- floatingDict ty = uncurry (*)--evalNeg :: NumType a -> (a -> a)-evalNeg (IntegralNumType ty) | IntegralDict <- integralDict ty = negate-evalNeg (FloatingNumType ty) | FloatingDict <- floatingDict ty = negate--evalAbs :: NumType a -> (a -> a)-evalAbs (IntegralNumType ty) | IntegralDict <- integralDict ty = abs-evalAbs (FloatingNumType ty) | FloatingDict <- floatingDict ty = abs--evalSig :: NumType a -> (a -> a)-evalSig (IntegralNumType ty) | IntegralDict <- integralDict ty = signum-evalSig (FloatingNumType ty) | FloatingDict <- floatingDict ty = signum--evalQuot :: IntegralType a -> ((a, a) -> a)-evalQuot ty | IntegralDict <- integralDict ty = uncurry quot--evalRem :: IntegralType a -> ((a, a) -> a)-evalRem ty | IntegralDict <- integralDict ty = uncurry rem--evalIDiv :: IntegralType a -> ((a, a) -> a)-evalIDiv ty | IntegralDict <- integralDict ty = uncurry div--evalMod :: IntegralType a -> ((a, a) -> a)-evalMod ty | IntegralDict <- integralDict ty = uncurry mod--evalBAnd :: IntegralType a -> ((a, a) -> a)-evalBAnd ty | IntegralDict <- integralDict ty = uncurry (.&.)--evalBOr :: IntegralType a -> ((a, a) -> a)-evalBOr ty | IntegralDict <- integralDict ty = uncurry (.|.)--evalBXor :: IntegralType a -> ((a, a) -> a)-evalBXor ty | IntegralDict <- integralDict ty = uncurry xor--evalBNot :: IntegralType a -> (a -> a)-evalBNot ty | IntegralDict <- integralDict ty = complement--evalBShiftL :: IntegralType a -> ((a, Int) -> a)-evalBShiftL ty | IntegralDict <- integralDict ty = uncurry shiftL--evalBShiftR :: IntegralType a -> ((a, Int) -> a)-evalBShiftR ty | IntegralDict <- integralDict ty = uncurry shiftR--evalBRotateL :: IntegralType a -> ((a, Int) -> a)-evalBRotateL ty | IntegralDict <- integralDict ty = uncurry rotateL--evalBRotateR :: IntegralType a -> ((a, Int) -> a)-evalBRotateR ty | IntegralDict <- integralDict ty = uncurry rotateR--evalFDiv :: FloatingType a -> ((a, a) -> a)-evalFDiv ty | FloatingDict <- floatingDict ty = uncurry (/)--evalRecip :: FloatingType a -> (a -> a)-evalRecip ty | FloatingDict <- floatingDict ty = recip----evalLt :: ScalarType a -> ((a, a) -> Bool)-evalLt (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry (<)-evalLt (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry (<)-evalLt (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry (<)--evalGt :: ScalarType a -> ((a, a) -> Bool)-evalGt (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry (>)-evalGt (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry (>)-evalGt (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry (>)--evalLtEq :: ScalarType a -> ((a, a) -> Bool)-evalLtEq (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry (<=)-evalLtEq (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry (<=)-evalLtEq (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry (<=)--evalGtEq :: ScalarType a -> ((a, a) -> Bool)-evalGtEq (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry (>=)-evalGtEq (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry (>=)-evalGtEq (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry (>=)--evalEq :: ScalarType a -> ((a, a) -> Bool)-evalEq (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry (==)-evalEq (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry (==)-evalEq (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry (==)--evalNEq :: ScalarType a -> ((a, a) -> Bool)-evalNEq (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry (/=)-evalNEq (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry (/=)-evalNEq (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry (/=)--evalMax :: ScalarType a -> ((a, a) -> a)-evalMax (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry max-evalMax (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry max-evalMax (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry max--evalMin :: ScalarType a -> ((a, a) -> a)-evalMin (NumScalarType (IntegralNumType ty))- | IntegralDict <- integralDict ty = uncurry min-evalMin (NumScalarType (FloatingNumType ty))- | FloatingDict <- floatingDict ty = uncurry min-evalMin (NonNumScalarType ty)- | NonNumDict <- nonNumDict ty = uncurry min+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_HADDOCK prune #-}+-- |+-- Module : Data.Array.Accelerate.Interpreter+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell+-- License : BSD3+--+-- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>+-- Stability : experimental+-- Portability : non-portable (GHC extensions)+--+-- This interpreter is meant to be a reference implementation of the semantics+-- of the embedded array language. The emphasis is on defining the semantics+-- clearly, not on performance.+--+-- /Surface types versus representation types/+--+-- As a general rule, we perform all computations on representation types and we store all data+-- as values of representation types. To guarantee the type safety of the interpreter, this+-- currently implies a lot of conversions between surface and representation types. Optimising+-- the code by eliminating back and forth conversions is fine, but only where it doesn't+-- negatively affects clarity — after all, the main purpose of the interpreter is to serve as an+-- executable specification.+--++module Data.Array.Accelerate.Interpreter (++ -- * Interpret an array expression+ Arrays, run, run1, stream,++ -- Internal (hidden)+ evalPrim, evalPrimConst, evalPrj++) where++-- standard libraries+import Control.Monad+import Data.Bits+import Data.Char ( chr, ord )+import Prelude hiding ( sum )++-- friends+import Data.Array.Accelerate.AST+import Data.Array.Accelerate.Array.Data+import Data.Array.Accelerate.Array.Representation ( SliceIndex(..) )+import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Error+import Data.Array.Accelerate.Trafo hiding ( Delayed )+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Type+import qualified Data.Array.Accelerate.Smart as Sugar+import qualified Data.Array.Accelerate.Trafo as AST+import qualified Data.Array.Accelerate.Array.Representation as R+++-- Program execution+-- -----------------++-- | Run a complete embedded array program using the reference interpreter.+--+run :: Arrays a => Sugar.Acc a -> a+run acc+ = let a = convertAccWith config acc+ in evalOpenAcc a Empty+++-- | Prepare and run an embedded array program of one argument+--+run1 :: (Arrays a, Arrays b) => (Sugar.Acc a -> Sugar.Acc b) -> a -> b+run1 afun+ = let f = convertAfunWith config afun+ in evalOpenAfun f Empty+++-- | Stream a lazily read list of input arrays through the given program,+-- collecting results as we go+--+stream :: (Arrays a, Arrays b) => (Sugar.Acc a -> Sugar.Acc b) -> [a] -> [b]+stream afun arrs = let go = run1 afun+ in map go arrs+++config :: Phase+config = Phase+ { recoverAccSharing = True+ , recoverExpSharing = True+ , floatOutAccFromExp = True+ , enableAccFusion = True+ , convertOffsetOfSegment = False+ }+++-- Delayed Arrays+-- --------------++-- Note that in contrast to the representation used in the optimised AST, the+-- delayed array representation used here is _only_ for delayed arrays --- we do+-- not require an optional Manifest|Delayed data type to evaluate the program.+--+data Delayed a where+ Delayed :: (Shape sh, Elt e)+ => sh+ -> (sh -> e)+ -> (Int -> e)+ -> Delayed (Array sh e)+++-- Array expression evaluation+-- ---------------------------++type EvalAcc acc = forall aenv a. acc aenv a -> Val aenv -> a++-- Evaluate an open array function+--+evalOpenAfun :: DelayedOpenAfun aenv f -> Val aenv -> f+evalOpenAfun (Alam f) aenv = \a -> evalOpenAfun f (aenv `Push` a)+evalOpenAfun (Abody b) aenv = evalOpenAcc b aenv+++-- The core interpreter for optimised array programs+--+evalOpenAcc+ :: forall aenv a.+ DelayedOpenAcc aenv a+ -> Val aenv+ -> a+evalOpenAcc AST.Delayed{} _ = $internalError "evalOpenAcc" "expected manifest array"+evalOpenAcc (AST.Manifest pacc) aenv =+ let+ manifest :: DelayedOpenAcc aenv a' -> a'+ manifest acc = evalOpenAcc acc aenv++ delayed :: DelayedOpenAcc aenv (Array sh e) -> Delayed (Array sh e)+ delayed AST.Manifest{} = $internalError "evalOpenAcc" "expected delayed array"+ delayed AST.Delayed{..} = Delayed (evalE extentD) (evalF indexD) (evalF linearIndexD)++ evalE :: DelayedExp aenv t -> t+ evalE exp = evalPreExp evalOpenAcc exp aenv++ evalF :: DelayedFun aenv f -> f+ evalF fun = evalPreFun evalOpenAcc fun aenv+ in+ case pacc of+ Avar ix -> prj ix aenv+ Alet acc1 acc2 -> evalOpenAcc acc2 (aenv `Push` manifest acc1)+ Atuple atup -> toTuple $ evalAtuple atup aenv+ Aprj ix atup -> evalPrj ix . fromTuple $ manifest atup+ Apply afun acc -> evalOpenAfun afun aenv $ manifest acc+ Aforeign _ afun acc -> evalOpenAfun afun Empty $ manifest acc+ Acond p acc1 acc2+ | evalE p -> manifest acc1+ | otherwise -> manifest acc2++ Awhile cond body acc -> go (manifest acc)+ where+ p = evalOpenAfun cond aenv+ f = evalOpenAfun body aenv+ go !x+ | p x ! Z = go (f x)+ | otherwise = x++ Use arr -> toArr arr+ Unit e -> unitOp (evalE e)++ -- Producers+ -- ---------+ Map f acc -> mapOp (evalF f) (delayed acc)+ Generate sh f -> generateOp (evalE sh) (evalF f)+ Transform sh p f acc -> transformOp (evalE sh) (evalF p) (evalF f) (delayed acc)+ Backpermute sh p acc -> backpermuteOp (evalE sh) (evalF p) (delayed acc)+ Reshape sh acc -> reshapeOp (evalE sh) (manifest acc)++ ZipWith f acc1 acc2 -> zipWithOp (evalF f) (delayed acc1) (delayed acc2)+ Replicate slice slix acc -> replicateOp slice (evalE slix) (manifest acc)+ Slice slice acc slix -> sliceOp slice (manifest acc) (evalE slix)++ -- Consumers+ -- ---------+ Fold f z acc -> foldOp (evalF f) (evalE z) (delayed acc)+ Fold1 f acc -> fold1Op (evalF f) (delayed acc)+ FoldSeg f z acc seg -> foldSegOp (evalF f) (evalE z) (delayed acc) (delayed seg)+ Fold1Seg f acc seg -> fold1SegOp (evalF f) (delayed acc) (delayed seg)+ Scanl f z acc -> scanlOp (evalF f) (evalE z) (delayed acc)+ Scanl' f z acc -> scanl'Op (evalF f) (evalE z) (delayed acc)+ Scanl1 f acc -> scanl1Op (evalF f) (delayed acc)+ Scanr f z acc -> scanrOp (evalF f) (evalE z) (delayed acc)+ 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)++-- Array tuple construction and projection+--+evalAtuple :: Atuple (DelayedOpenAcc aenv) t -> Val aenv -> t+evalAtuple NilAtup _ = ()+evalAtuple (SnocAtup t a) aenv = (evalAtuple t aenv, evalOpenAcc a aenv)+++-- Array primitives+-- ----------------++unitOp :: Elt e => e -> Scalar e+unitOp e = newArray Z (const e)+++generateOp+ :: (Shape sh, Elt e)+ => sh+ -> (sh -> e)+ -> Array sh e+generateOp = newArray+++transformOp+ :: (Shape sh, Shape sh', Elt b)+ => sh'+ -> (sh' -> sh)+ -> (a -> b)+ -> Delayed (Array sh a)+ -> Array sh' b+transformOp sh' p f (Delayed _ xs _)+ = newArray sh' (\ix -> f (xs $ p ix))+++reshapeOp+ :: (Shape sh, Shape sh', Elt e)+ => sh+ -> Array sh' e+ -> Array sh e+reshapeOp newShape arr@(Array _ adata)+ = $boundsCheck "reshape" "shape mismatch" (size newShape == size (shape arr))+ $ Array (fromElt newShape) adata+++replicateOp+ :: (Shape sh, Shape sl, Elt slix, Elt e)+ => SliceIndex (EltRepr slix) (EltRepr sl) co (EltRepr sh)+ -> slix+ -> Array sl e+ -> Array sh e+replicateOp slice slix arr+ = newArray (toElt sh) (\ix -> arr ! liftToElt pf ix)+ where+ (sh, pf) = extend slice (fromElt slix) (fromElt (shape arr))++ extend :: SliceIndex slix sl co dim+ -> slix+ -> sl+ -> (dim, dim -> sl)+ extend SliceNil () () = ((), const ())+ extend (SliceAll sliceIdx) (slx, ()) (sl, sz)+ = let (dim', f') = extend sliceIdx slx sl+ in ((dim', sz), \(ix, i) -> (f' ix, i))+ extend (SliceFixed sliceIdx) (slx, sz) sl+ = let (dim', f') = extend sliceIdx slx sl+ in ((dim', sz), \(ix, _) -> f' ix)+++sliceOp+ :: (Shape sh, Shape sl, Elt slix, Elt e)+ => SliceIndex (EltRepr slix) (EltRepr sl) co (EltRepr sh)+ -> Array sh e+ -> slix+ -> Array sl e+sliceOp slice arr slix+ = newArray (toElt sh) (\ix -> arr ! liftToElt pf ix)+ where+ (sh, pf) = restrict slice (fromElt slix) (fromElt (shape arr))++ restrict :: SliceIndex slix sl co sh+ -> slix+ -> sh+ -> (sl, sl -> sh)+ restrict SliceNil () () = ((), const ())+ restrict (SliceAll sliceIdx) (slx, ()) (sl, sz)+ = let (sl', f') = restrict sliceIdx slx sl+ in ((sl', sz), \(ix, i) -> (f' ix, i))+ restrict (SliceFixed sliceIdx) (slx, i) (sl, sz)+ = let (sl', f') = restrict sliceIdx slx sl+ in $indexCheck "slice" i sz $ (sl', \ix -> (f' ix, i))+++mapOp :: (Shape sh, Elt a, Elt b)+ => (a -> b)+ -> Delayed (Array sh a)+ -> Array sh b+mapOp f (Delayed sh xs _)+ = newArray sh (\ix -> f (xs ix))+++zipWithOp+ :: (Shape sh, Elt a, Elt b, Elt c)+ => (a -> b -> c)+ -> Delayed (Array sh a)+ -> Delayed (Array sh b)+ -> Array sh c+zipWithOp f (Delayed shx xs _) (Delayed shy ys _)+ = newArray (shx `intersect` shy) (\ix -> f (xs ix) (ys ix))+++foldOp+ :: (Shape sh, Elt e)+ => (e -> e -> e)+ -> e+ -> Delayed (Array (sh :. Int) e)+ -> Array sh e+foldOp f z (Delayed (sh :. n) arr _)+ | size sh == 0+ = newArray (listToShape . map (max 1) . shapeToList $ sh) (const z)++ | otherwise+ = newArray sh (\ix -> iter (Z:.n) (\(Z:.i) -> arr (ix :. i)) f z)+++fold1Op+ :: (Shape sh, Elt e)+ => (e -> e -> e)+ -> Delayed (Array (sh :. Int) e)+ -> Array sh e+fold1Op f (Delayed (sh :. n) arr _)+ = newArray sh (\ix -> iter1 (Z:.n) (\(Z:.i) -> arr (ix :. i)) f)+++foldSegOp+ :: forall sh e i. (Shape sh, Elt e, Elt i, IsIntegral i)+ => (e -> e -> e)+ -> e+ -> Delayed (Array (sh :. Int) e)+ -> Delayed (Segments i)+ -> Array (sh :. Int) e+foldSegOp f z (Delayed (sh :. _) arr _) seg@(Delayed (Z :. n) _ _)+ | IntegralDict <- integralDict (integralType :: IntegralType i)+ = newArray (sh :. n)+ $ \(sz :. ix) -> let start = fromIntegral $ offset ! (Z :. ix)+ end = fromIntegral $ offset ! (Z :. ix+1)+ in+ iter (Z :. end-start) (\(Z:.i) -> arr (sz :. start+i)) f z+ where+ offset = scanlOp (+) 0 seg+++fold1SegOp+ :: forall sh e i. (Shape sh, Elt e, Elt i, IsIntegral i)+ => (e -> e -> e)+ -> Delayed (Array (sh :. Int) e)+ -> Delayed (Segments i)+ -> Array (sh :. Int) e+fold1SegOp f (Delayed (sh :. _) arr _) seg@(Delayed (Z :. n) _ _)+ | IntegralDict <- integralDict (integralType :: IntegralType i)+ = newArray (sh :. n)+ $ \(sz :. ix) -> let start = fromIntegral $ offset ! (Z :. ix)+ end = fromIntegral $ offset ! (Z :. ix+1)+ in+ iter1 (Z :. end-start) (\(Z:.i) -> arr (sz :. start+i)) f+ where+ offset = scanlOp (+) 0 seg+++scanl1Op+ :: Elt e+ => (e -> e -> e)+ -> Delayed (Vector e)+ -> Vector e+scanl1Op f (Delayed sh@(Z :. n) _ ain)+ = adata `seq` Array (fromElt sh) adata+ where+ f' = sinkFromElt2 f+ --+ (adata, _) = runArrayData $ do+ aout <- newArrayData n++ let write (Z:.0) = unsafeWriteArrayData aout 0 (fromElt $ ain 0)+ write (Z:.i) = do+ x <- unsafeReadArrayData aout (i-1)+ y <- return . fromElt $ ain i+ unsafeWriteArrayData aout i (f' x y)++ iter1 sh write (>>)+ return (aout, undefined)+++scanlOp+ :: Elt e+ => (e -> e -> e)+ -> e+ -> Delayed (Vector e)+ -> Vector e+scanlOp f z (Delayed (Z :. n) _ ain)+ = adata `seq` Array (fromElt sh') adata+ where+ sh' = Z :. n+1+ f' = sinkFromElt2 f+ --+ (adata, _) = runArrayData $ do+ aout <- newArrayData (n+1)++ let write (Z:.0) = unsafeWriteArrayData aout 0 (fromElt z)+ write (Z:.i) = do+ x <- unsafeReadArrayData aout (i-1)+ y <- return . fromElt $ ain (i-1)+ unsafeWriteArrayData aout i (f' x y)++ iter sh' write (>>) (return ())+ return (aout, undefined)+++scanl'Op+ :: Elt e+ => (e -> e -> e)+ -> e+ -> Delayed (Vector e)+ -> (Vector e, Scalar e)+scanl'Op f z (scanlOp f z -> arr)+ = let+ arr' = case arr of Array _ adata -> Array ((), n-1) adata+ sum = unitOp (arr ! (Z:.n-1))+ n = size (shape arr)+ in+ (arr', sum)+++scanrOp+ :: Elt e+ => (e -> e -> e)+ -> e+ -> Delayed (Vector e)+ -> Vector e+scanrOp f z (Delayed (Z :. n) _ ain)+ = adata `seq` Array (fromElt sh') adata+ where+ sh' = Z :. n+1+ f' = sinkFromElt2 f+ --+ (adata, _) = runArrayData $ do+ aout <- newArrayData (n+1)++ let write (Z:.0) = unsafeWriteArrayData aout n (fromElt z)+ write (Z:.i) = do+ x <- unsafeReadArrayData aout (n-i+1)+ y <- return . fromElt $ ain (n-i)+ unsafeWriteArrayData aout (n-i) (f' x y)++ iter sh' write (>>) (return ())+ return (aout, undefined)+++scanr1Op+ :: Elt e+ => (e -> e -> e)+ -> Delayed (Vector e)+ -> Vector e+scanr1Op f (Delayed sh@(Z :. n) _ ain)+ = adata `seq` Array (fromElt sh) adata+ where+ f' = sinkFromElt2 f+ --+ (adata, _) = runArrayData $ do+ aout <- newArrayData n++ let write (Z:.0) = unsafeWriteArrayData aout (n-1) (fromElt $ ain (n-1))+ write (Z:.i) = do+ x <- unsafeReadArrayData aout (n-i)+ y <- return . fromElt $ ain (n-i-1)+ unsafeWriteArrayData aout (n-i-1) (f' x y)++ iter1 sh write (>>)+ return (aout, undefined)+++scanr'Op+ :: forall e. Elt e+ => (e -> e -> e)+ -> e+ -> Delayed (Vector e)+ -> (Vector e, Scalar e)+scanr'Op f z (Delayed (Z :. n) _ ain)+ = (Array ((),n) adata, unitOp (toElt asum))+ where+ f' x y = sinkFromElt2 f (fromElt x) y+ --+ (adata, asum) = runArrayData $ do+ aout <- newArrayData n++ let trav i !y | i < 0 = return y+ trav i y = do+ unsafeWriteArrayData aout i y+ trav (i-1) (f' (ain i) y)++ final <- trav (n-1) (fromElt z)+ return (aout, final)+++permuteOp+ :: (Shape sh, Shape sh', Elt e)+ => (e -> e -> e)+ -> Array sh' e+ -> (sh -> sh')+ -> Delayed (Array sh e)+ -> Array sh' e+permuteOp f def@(Array _ adef) p (Delayed sh _ ain)+ = adata `seq` Array (fromElt sh') adata+ where+ sh' = shape def+ n' = size sh'+ f' = sinkFromElt2 f+ --+ (adata, _) = runArrayData $ do+ aout <- newArrayData n'++ let -- initialise array with default values+ init i+ | i >= n' = return ()+ | otherwise = do+ x <- unsafeReadArrayData adef i+ unsafeWriteArrayData aout i x+ init (i+1)++ -- project each element onto the destination array and update+ update src+ = let dst = p src+ i = toIndex sh src+ j = toIndex sh' dst+ in+ unless (fromElt dst == R.ignore) $ do+ x <- return . fromElt $ ain i+ y <- unsafeReadArrayData aout j+ unsafeWriteArrayData aout j (f' x y)++ init 0+ iter sh update (>>) (return ())+ return (aout, undefined)+++backpermuteOp+ :: (Shape sh, Shape sh', Elt e)+ => sh'+ -> (sh' -> sh)+ -> Delayed (Array sh e)+ -> Array sh' e+backpermuteOp sh' p (Delayed _ arr _)+ = newArray sh' (\ix -> arr $ p ix)+++stencilOp+ :: (Elt a, Elt b, Stencil sh a stencil)+ => (stencil -> b)+ -> Boundary (EltRepr a)+ -> Array sh a+ -> Array sh b+stencilOp stencil boundary arr+ = newArray 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'+++stencil2Op+ :: (Elt a, Elt b, Elt c, Stencil sh a stencil1, Stencil sh b stencil2)+ => (stencil1 -> stencil2 -> c)+ -> Boundary (EltRepr a)+ -> Array sh a+ -> Boundary (EltRepr b)+ -> Array sh b+ -> Array sh c+stencil2Op stencil boundary1 arr1 boundary2 arr2+ = newArray (sh1 `intersect` sh2) f+ where+ sh1 = shape arr1+ sh2 = shape arr2+ f ix = stencil (stencilAccess bounded1 ix)+ (stencilAccess bounded2 ix)++ bounded1 ix =+ case bound sh1 ix boundary1 of+ Left v -> toElt v+ Right ix' -> arr1 ! ix'++ bounded2 ix =+ case bound sh2 ix boundary2 of+ Left v -> toElt v+ Right ix' -> arr2 ! ix'+++-- Scalar expression evaluation+-- ----------------------------++-- Evaluate a closed scalar expression+--+evalPreExp :: EvalAcc acc -> PreExp acc aenv t -> Val aenv -> t+evalPreExp evalAcc e aenv = evalPreOpenExp evalAcc e EmptyElt aenv++-- Evaluate a closed scalar function+--+evalPreFun :: EvalAcc acc -> PreFun acc aenv t -> Val aenv -> t+evalPreFun evalAcc f aenv = evalPreOpenFun evalAcc f EmptyElt aenv++-- Evaluate an open scalar function+--+evalPreOpenFun :: EvalAcc acc -> PreOpenFun acc env aenv t -> ValElt env -> Val aenv -> t+evalPreOpenFun evalAcc (Body e) env aenv = evalPreOpenExp evalAcc e env aenv+evalPreOpenFun evalAcc (Lam f) env aenv =+ \x -> evalPreOpenFun evalAcc f (env `PushElt` fromElt x) aenv+++-- Evaluate an open scalar expression+--+-- NB: The implementation of 'Index' and 'Shape' demonstrate clearly why+-- array expressions must be hoisted out of scalar expressions before code+-- execution. If these operations are in the body of a function that gets+-- mapped over an array, the array argument would be evaluated many times+-- leading to a large amount of wasteful recomputation.+--+evalPreOpenExp+ :: forall acc env aenv t.+ EvalAcc acc+ -> PreOpenExp acc env aenv t+ -> ValElt env+ -> Val aenv+ -> t+evalPreOpenExp evalAcc pexp env aenv =+ let+ evalE :: PreOpenExp acc env aenv t' -> t'+ evalE e = evalPreOpenExp evalAcc e env aenv++ evalF :: PreOpenFun acc env aenv f' -> f'+ evalF f = evalPreOpenFun evalAcc f env aenv++ evalA :: acc aenv a -> a+ evalA a = evalAcc a aenv+ in+ case pexp of+ Let exp1 exp2 -> let !v1 = evalE exp1+ env' = env `PushElt` fromElt v1+ in evalPreOpenExp evalAcc exp2 env' aenv+ Var ix -> prjElt ix env+ Const c -> toElt c+ PrimConst c -> evalPrimConst c+ PrimApp f x -> evalPrim f (evalE x)+ Tuple tup -> toTuple $ evalTuple evalAcc tup env aenv+ Prj ix tup -> evalPrj ix . fromTuple $ evalE tup+ IndexNil -> Z+ IndexAny -> Any+ IndexCons sh sz -> evalE sh :. evalE sz+ IndexHead sh -> let _ :. ix = evalE sh in ix+ IndexTail sh -> let ix :. _ = evalE sh in ix+ IndexSlice slice slix sh -> toElt $ restrict slice (fromElt (evalE slix))+ (fromElt (evalE sh))+ where+ restrict :: SliceIndex slix sl co sh -> slix -> sh -> sl+ restrict SliceNil () () = ()+ restrict (SliceAll sliceIdx) (slx, ()) (sl, sz) =+ let sl' = restrict sliceIdx slx sl+ in (sl', sz)+ restrict (SliceFixed sliceIdx) (slx, _i) (sl, _sz) =+ restrict sliceIdx slx sl++ IndexFull slice slix sh -> toElt $ extend slice (fromElt (evalE slix))+ (fromElt (evalE sh))+ where+ extend :: SliceIndex slix sl co sh -> slix -> sl -> sh+ extend SliceNil () () = ()+ extend (SliceAll sliceIdx) (slx, ()) (sl, sz) =+ let sh' = extend sliceIdx slx sl+ in (sh', sz)+ extend (SliceFixed sliceIdx) (slx, sz) sl =+ let sh' = extend sliceIdx slx sl+ in (sh', sz)++ ToIndex sh ix -> toIndex (evalE sh) (evalE ix)+ FromIndex sh ix -> fromIndex (evalE sh) (evalE ix)+ Cond c t e+ | evalE c -> evalE t+ | otherwise -> evalE e++ While cond body seed -> go (evalE seed)+ where+ f = evalF body+ p = evalF cond+ go !x+ | p x = go (f x)+ | otherwise = x++ Index acc ix -> evalA acc ! evalE ix+ LinearIndex acc i -> let a = evalA acc+ ix = fromIndex (shape a) (evalE i)+ in a ! ix+ Shape acc -> shape (evalA acc)+ ShapeSize sh -> size (evalE sh)+ Intersect sh1 sh2 -> intersect (evalE sh1) (evalE sh2)+ Foreign _ f e -> evalPreOpenFun evalAcc f EmptyElt Empty $ evalE e+++-- Scalar primitives+-- -----------------++evalPrimConst :: PrimConst a -> a+evalPrimConst (PrimMinBound ty) = evalMinBound ty+evalPrimConst (PrimMaxBound ty) = evalMaxBound ty+evalPrimConst (PrimPi ty) = evalPi ty++evalPrim :: PrimFun p -> p+evalPrim (PrimAdd ty) = evalAdd ty+evalPrim (PrimSub ty) = evalSub ty+evalPrim (PrimMul ty) = evalMul ty+evalPrim (PrimNeg ty) = evalNeg ty+evalPrim (PrimAbs ty) = evalAbs ty+evalPrim (PrimSig ty) = evalSig ty+evalPrim (PrimQuot ty) = evalQuot ty+evalPrim (PrimRem ty) = evalRem ty+evalPrim (PrimIDiv ty) = evalIDiv ty+evalPrim (PrimMod ty) = evalMod ty+evalPrim (PrimBAnd ty) = evalBAnd ty+evalPrim (PrimBOr ty) = evalBOr ty+evalPrim (PrimBXor ty) = evalBXor ty+evalPrim (PrimBNot ty) = evalBNot ty+evalPrim (PrimBShiftL ty) = evalBShiftL ty+evalPrim (PrimBShiftR ty) = evalBShiftR ty+evalPrim (PrimBRotateL ty) = evalBRotateL ty+evalPrim (PrimBRotateR ty) = evalBRotateR ty+evalPrim (PrimFDiv ty) = evalFDiv ty+evalPrim (PrimRecip ty) = evalRecip ty+evalPrim (PrimSin ty) = evalSin ty+evalPrim (PrimCos ty) = evalCos ty+evalPrim (PrimTan ty) = evalTan ty+evalPrim (PrimAsin ty) = evalAsin ty+evalPrim (PrimAcos ty) = evalAcos ty+evalPrim (PrimAtan ty) = evalAtan ty+evalPrim (PrimAsinh ty) = evalAsinh ty+evalPrim (PrimAcosh ty) = evalAcosh ty+evalPrim (PrimAtanh ty) = evalAtanh ty+evalPrim (PrimExpFloating ty) = evalExpFloating ty+evalPrim (PrimSqrt ty) = evalSqrt ty+evalPrim (PrimLog ty) = evalLog ty+evalPrim (PrimFPow ty) = evalFPow ty+evalPrim (PrimLogBase ty) = evalLogBase ty+evalPrim (PrimTruncate ta tb) = evalTruncate ta tb+evalPrim (PrimRound ta tb) = evalRound ta tb+evalPrim (PrimFloor ta tb) = evalFloor ta tb+evalPrim (PrimCeiling ta tb) = evalCeiling ta tb+evalPrim (PrimAtan2 ty) = evalAtan2 ty+evalPrim (PrimLt ty) = evalLt ty+evalPrim (PrimGt ty) = evalGt ty+evalPrim (PrimLtEq ty) = evalLtEq ty+evalPrim (PrimGtEq ty) = evalGtEq ty+evalPrim (PrimEq ty) = evalEq ty+evalPrim (PrimNEq ty) = evalNEq ty+evalPrim (PrimMax ty) = evalMax ty+evalPrim (PrimMin ty) = evalMin ty+evalPrim PrimLAnd = evalLAnd+evalPrim PrimLOr = evalLOr+evalPrim PrimLNot = evalLNot+evalPrim PrimOrd = evalOrd+evalPrim PrimChr = evalChr+evalPrim PrimBoolToInt = evalBoolToInt+evalPrim (PrimFromIntegral ta tb) = evalFromIntegral ta tb+++-- Tuple construction and projection+-- ---------------------------------++evalTuple :: EvalAcc acc -> Tuple (PreOpenExp acc env aenv) t -> ValElt env -> Val aenv -> t+evalTuple _ NilTup _env _aenv = ()+evalTuple evalAcc (tup `SnocTup` e) env aenv =+ (evalTuple evalAcc tup env aenv, evalPreOpenExp evalAcc e env aenv)++evalPrj :: TupleIdx t e -> t -> e+evalPrj ZeroTupIdx (!_, v) = v+evalPrj (SuccTupIdx idx) (tup, !_) = evalPrj idx tup+ -- FIXME: Strictly speaking, we ought to force all components of a tuples;+ -- not only those that we happen to encounter during the recursive+ -- walk.+++-- Implementation of scalar primitives+-- -----------------------------------++evalLAnd :: (Bool, Bool) -> Bool+evalLAnd (x, y) = x && y++evalLOr :: (Bool, Bool) -> Bool+evalLOr (x, y) = x || y++evalLNot :: Bool -> Bool+evalLNot = not++evalOrd :: Char -> Int+evalOrd = ord++evalChr :: Int -> Char+evalChr = chr++evalBoolToInt :: Bool -> Int+evalBoolToInt = fromEnum++evalFromIntegral :: IntegralType a -> NumType b -> a -> b+evalFromIntegral ta (IntegralNumType tb)+ | IntegralDict <- integralDict ta+ , IntegralDict <- integralDict tb+ = fromIntegral++evalFromIntegral ta (FloatingNumType tb)+ | IntegralDict <- integralDict ta+ , FloatingDict <- floatingDict tb+ = fromIntegral+++-- Extract methods from reified dictionaries+--++-- Constant methods of Bounded+--++evalMinBound :: BoundedType a -> a+evalMinBound (IntegralBoundedType ty)+ | IntegralDict <- integralDict ty+ = minBound++evalMinBound (NonNumBoundedType ty)+ | NonNumDict <- nonNumDict ty+ = minBound++evalMaxBound :: BoundedType a -> a+evalMaxBound (IntegralBoundedType ty)+ | IntegralDict <- integralDict ty+ = maxBound++evalMaxBound (NonNumBoundedType ty)+ | NonNumDict <- nonNumDict ty+ = maxBound++-- Constant method of floating+--++evalPi :: FloatingType a -> a+evalPi ty | FloatingDict <- floatingDict ty = pi++evalSin :: FloatingType a -> (a -> a)+evalSin ty | FloatingDict <- floatingDict ty = sin++evalCos :: FloatingType a -> (a -> a)+evalCos ty | FloatingDict <- floatingDict ty = cos++evalTan :: FloatingType a -> (a -> a)+evalTan ty | FloatingDict <- floatingDict ty = tan++evalAsin :: FloatingType a -> (a -> a)+evalAsin ty | FloatingDict <- floatingDict ty = asin++evalAcos :: FloatingType a -> (a -> a)+evalAcos ty | FloatingDict <- floatingDict ty = acos++evalAtan :: FloatingType a -> (a -> a)+evalAtan ty | FloatingDict <- floatingDict ty = atan++evalAsinh :: FloatingType a -> (a -> a)+evalAsinh ty | FloatingDict <- floatingDict ty = asinh++evalAcosh :: FloatingType a -> (a -> a)+evalAcosh ty | FloatingDict <- floatingDict ty = acosh++evalAtanh :: FloatingType a -> (a -> a)+evalAtanh ty | FloatingDict <- floatingDict ty = atanh++evalExpFloating :: FloatingType a -> (a -> a)+evalExpFloating ty | FloatingDict <- floatingDict ty = exp++evalSqrt :: FloatingType a -> (a -> a)+evalSqrt ty | FloatingDict <- floatingDict ty = sqrt++evalLog :: FloatingType a -> (a -> a)+evalLog ty | FloatingDict <- floatingDict ty = log++evalFPow :: FloatingType a -> ((a, a) -> a)+evalFPow ty | FloatingDict <- floatingDict ty = uncurry (**)++evalLogBase :: FloatingType a -> ((a, a) -> a)+evalLogBase ty | FloatingDict <- floatingDict ty = uncurry logBase++evalTruncate :: FloatingType a -> IntegralType b -> (a -> b)+evalTruncate ta tb+ | FloatingDict <- floatingDict ta+ , IntegralDict <- integralDict tb+ = truncate++evalRound :: FloatingType a -> IntegralType b -> (a -> b)+evalRound ta tb+ | FloatingDict <- floatingDict ta+ , IntegralDict <- integralDict tb+ = round++evalFloor :: FloatingType a -> IntegralType b -> (a -> b)+evalFloor ta tb+ | FloatingDict <- floatingDict ta+ , IntegralDict <- integralDict tb+ = floor++evalCeiling :: FloatingType a -> IntegralType b -> (a -> b)+evalCeiling ta tb+ | FloatingDict <- floatingDict ta+ , IntegralDict <- integralDict tb+ = ceiling++evalAtan2 :: FloatingType a -> ((a, a) -> a)+evalAtan2 ty | FloatingDict <- floatingDict ty = uncurry atan2+++-- Methods of Num+--++evalAdd :: NumType a -> ((a, a) -> a)+evalAdd (IntegralNumType ty) | IntegralDict <- integralDict ty = uncurry (+)+evalAdd (FloatingNumType ty) | FloatingDict <- floatingDict ty = uncurry (+)++evalSub :: NumType a -> ((a, a) -> a)+evalSub (IntegralNumType ty) | IntegralDict <- integralDict ty = uncurry (-)+evalSub (FloatingNumType ty) | FloatingDict <- floatingDict ty = uncurry (-)++evalMul :: NumType a -> ((a, a) -> a)+evalMul (IntegralNumType ty) | IntegralDict <- integralDict ty = uncurry (*)+evalMul (FloatingNumType ty) | FloatingDict <- floatingDict ty = uncurry (*)++evalNeg :: NumType a -> (a -> a)+evalNeg (IntegralNumType ty) | IntegralDict <- integralDict ty = negate+evalNeg (FloatingNumType ty) | FloatingDict <- floatingDict ty = negate++evalAbs :: NumType a -> (a -> a)+evalAbs (IntegralNumType ty) | IntegralDict <- integralDict ty = abs+evalAbs (FloatingNumType ty) | FloatingDict <- floatingDict ty = abs++evalSig :: NumType a -> (a -> a)+evalSig (IntegralNumType ty) | IntegralDict <- integralDict ty = signum+evalSig (FloatingNumType ty) | FloatingDict <- floatingDict ty = signum++evalQuot :: IntegralType a -> ((a, a) -> a)+evalQuot ty | IntegralDict <- integralDict ty = uncurry quot++evalRem :: IntegralType a -> ((a, a) -> a)+evalRem ty | IntegralDict <- integralDict ty = uncurry rem++evalIDiv :: IntegralType a -> ((a, a) -> a)+evalIDiv ty | IntegralDict <- integralDict ty = uncurry div++evalMod :: IntegralType a -> ((a, a) -> a)+evalMod ty | IntegralDict <- integralDict ty = uncurry mod++evalBAnd :: IntegralType a -> ((a, a) -> a)+evalBAnd ty | IntegralDict <- integralDict ty = uncurry (.&.)++evalBOr :: IntegralType a -> ((a, a) -> a)+evalBOr ty | IntegralDict <- integralDict ty = uncurry (.|.)++evalBXor :: IntegralType a -> ((a, a) -> a)+evalBXor ty | IntegralDict <- integralDict ty = uncurry xor++evalBNot :: IntegralType a -> (a -> a)+evalBNot ty | IntegralDict <- integralDict ty = complement++evalBShiftL :: IntegralType a -> ((a, Int) -> a)+evalBShiftL ty | IntegralDict <- integralDict ty = uncurry shiftL++evalBShiftR :: IntegralType a -> ((a, Int) -> a)+evalBShiftR ty | IntegralDict <- integralDict ty = uncurry shiftR++evalBRotateL :: IntegralType a -> ((a, Int) -> a)+evalBRotateL ty | IntegralDict <- integralDict ty = uncurry rotateL++evalBRotateR :: IntegralType a -> ((a, Int) -> a)+evalBRotateR ty | IntegralDict <- integralDict ty = uncurry rotateR++evalFDiv :: FloatingType a -> ((a, a) -> a)+evalFDiv ty | FloatingDict <- floatingDict ty = uncurry (/)++evalRecip :: FloatingType a -> (a -> a)+evalRecip ty | FloatingDict <- floatingDict ty = recip++++evalLt :: ScalarType a -> ((a, a) -> Bool)+evalLt (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry (<)+evalLt (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry (<)+evalLt (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry (<)++evalGt :: ScalarType a -> ((a, a) -> Bool)+evalGt (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry (>)+evalGt (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry (>)+evalGt (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry (>)++evalLtEq :: ScalarType a -> ((a, a) -> Bool)+evalLtEq (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry (<=)+evalLtEq (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry (<=)+evalLtEq (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry (<=)++evalGtEq :: ScalarType a -> ((a, a) -> Bool)+evalGtEq (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry (>=)+evalGtEq (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry (>=)+evalGtEq (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry (>=)++evalEq :: ScalarType a -> ((a, a) -> Bool)+evalEq (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry (==)+evalEq (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry (==)+evalEq (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry (==)++evalNEq :: ScalarType a -> ((a, a) -> Bool)+evalNEq (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry (/=)+evalNEq (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry (/=)+evalNEq (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry (/=)++evalMax :: ScalarType a -> ((a, a) -> a)+evalMax (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry max+evalMax (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry max+evalMax (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry max++evalMin :: ScalarType a -> ((a, a) -> a)+evalMin (NumScalarType (IntegralNumType ty)) | IntegralDict <- integralDict ty = uncurry min+evalMin (NumScalarType (FloatingNumType ty)) | FloatingDict <- floatingDict ty = uncurry min+evalMin (NonNumScalarType ty) | NonNumDict <- nonNumDict ty = uncurry min
Data/Array/Accelerate/Language.hs view
@@ -4,8 +4,8 @@ {-# OPTIONS -fno-warn-orphans #-} -- | -- Module : Data.Array.Accelerate.Language--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -93,7 +93,7 @@ (&&*), (||*), not, -- * Conversions- boolToInt, fromIntegral,+ ord, chr, boolToInt, fromIntegral, -- * Constants ignore@@ -105,9 +105,10 @@ -- standard libraries import Prelude ( Bounded, Enum, Num, Real, Integral, Floating, Fractional,- RealFloat, RealFrac, Eq, Ord, Bool, Char, Float, Double, (.), ($), id, error )+ RealFloat, RealFrac, Eq, Ord, Bool, Char, String, (.), ($), error ) import Data.Bits ( Bits((.&.), (.|.), xor, complement) ) import qualified Prelude as P+import Text.Printf -- friends import Data.Array.Accelerate.Type@@ -139,7 +140,7 @@ -- -- For example, assuming 'arr' is a vector (one-dimensional array), ----- > replicate (Z :.2 :.All :.3) arr+-- > replicate (lift (Z :. (2::Int) :. All :. (3::Int))) arr -- -- yields a three dimensional array, where 'arr' is replicated twice across the -- first and three times across the third dimension.@@ -167,6 +168,16 @@ -- > let (Z :. i) = unlift ix -- > in fromIntegral i --+-- [/NOTE:/]+--+-- Using 'generate', it is possible to introduce nested data parallelism, which+-- will cause the program to fail.+--+-- If the index given by the scalar function is then used to dispatch further+-- parallel work, whose result is returned into 'Exp' terms by array indexing+-- operations such as (`!`) or `the`, the program will fail with the error:+-- '.\/Data\/Array\/Accelerate\/Trafo\/Sharing.hs:447 (convertSharingExp): inconsistent valuation \@ shared \'Exp\' tree ...'.+-- generate :: (Shape ix, Elt a) => Exp ix -> (Exp ix -> Exp a)@@ -199,10 +210,11 @@ -- following will select a specific row and yield a one dimensional -- result: ----- > slice mat (constant (Z :. (2::Int) :. All))+-- > slice mat (lift (Z :. (2::Int) :. All)) ----- A fully specified index (with no `All`s) would return a single--- element (zero dimensional array).+-- A fully specified index (with no `All`s) would return a single element (zero+-- dimensional array).+-- slice :: (Slice slix, Elt e) => Acc (Array (FullShape slix) e) -> Exp slix@@ -514,10 +526,6 @@ -- -- > (acc1 >-> acc2) arrs = let tmp = acc1 arrs in acc2 tmp ----- Operationally, the array computations 'acc1' and 'acc2' will not share any sub-computations,--- neither between each other nor with the environment. This makes them truly independent stages--- that only communicate by way of the result of 'acc1' which is being fed as an argument to 'acc2'.--- infixl 1 >-> (>->) :: (Arrays a, Arrays b, Arrays c) => (Acc a -> Acc b) -> (Acc b -> Acc c) -> (Acc a -> Acc c) (>->) = Acc $$$ Pipe@@ -537,7 +545,7 @@ -- | An array-level while construct ---awhile :: (Arrays a)+awhile :: Arrays a => (Acc a -> Acc (Scalar Bool)) -> (Acc a -> Acc a) -> Acc a@@ -632,6 +640,9 @@ -- Instances of all relevant H98 classes -- ------------------------------------- +preludeError :: String -> String -> a+preludeError x y = error (printf "Prelude.%s applied to EDSL types: use %s instead" x y)+ instance (Elt t, IsBounded t) => Bounded (Exp t) where minBound = mkMinBound maxBound = mkMaxBound@@ -643,13 +654,19 @@ instance (Elt t, IsScalar t) => Prelude.Eq (Exp t) where -- FIXME: instance makes no sense with standard signatures- (==) = error "Prelude.Eq.== applied to EDSL types"+ (==) = preludeError "Eq.==" "(==*)"+ (/=) = preludeError "Eq./=" "(/=*)" instance (Elt t, IsScalar t) => Prelude.Ord (Exp t) where -- FIXME: instance makes no sense with standard signatures- compare = error "Prelude.Ord.compare applied to EDSL types" min = mkMin max = mkMax+ --+ compare = error "Prelude.Ord.compare applied to EDSL types"+ (<) = preludeError "Ord.<" "(<*)"+ (<=) = preludeError "Ord.<=" "(<=*)"+ (>) = preludeError "Ord.>" "(>*)"+ (>=) = preludeError "Ord.>=" "(>=*)" instance (Elt t, IsNum t, IsIntegral t) => Bits (Exp t) where (.&.) = mkBAnd@@ -881,6 +898,16 @@ -- Conversions -- -----------++-- |Convert a character to an 'Int'.+--+ord :: Exp Char -> Exp Int+ord = mkOrd++-- |Convert an 'Int' into a character.+--+chr :: Exp Int -> Exp Char+chr = mkChr -- |Convert a Boolean value to an 'Int', where 'False' turns into '0' and 'True' -- into '1'.
Data/Array/Accelerate/Prelude.hs view
@@ -7,8 +7,8 @@ {-# LANGUAGE TypeOperators #-} -- | -- Module : Data.Array.Accelerate.Prelude--- Copyright : [2010..2011] Manuel M T Chakravarty, Gabriele Keller, Ben Lever--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2009..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- [2010..2011] Ben Lever -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -61,14 +61,14 @@ -- * Permutations reverse, transpose, - -- Extracting sub-vectors+ -- * Extracting sub-vectors init, tail, take, drop, slit, -- * Array-level flow control (?|), -- * Expression-level flow control- (?),+ (?), caseof, -- * Scalar iteration iterate,@@ -81,13 +81,13 @@ lift1, lift2, ilift1, ilift2, -- ** Tuple construction and destruction- fst, snd, curry, uncurry,+ fst, afst, snd, asnd, curry, uncurry, -- ** Index construction and destruction index0, index1, unindex1, index2, unindex2, -- * Array operations with a scalar result- the, null,+ the, null, length, ) where @@ -936,6 +936,7 @@ -- Instead, we should have a primitive that directly encodes the -- compaction pattern of the permutation function. +{-# NOINLINE filter #-} {-# RULES "ACC filter/filter" forall f g arr. filter f (filter g arr) = filter (\x -> g x &&* f x) arr@@ -952,107 +953,114 @@ -- For example: -- -- > input = [1, 9, 6, 4, 4, 2, 0, 1, 2]--- > map = [1, 3, 7, 2, 5, 3]+-- > from = [1, 3, 7, 2, 5, 3] -- > -- > output = [9, 4, 1, 6, 2, 4] ---gather :: (Elt e)- => Acc (Vector Int) -- ^map+gather :: Elt e+ => Acc (Vector Int) -- ^index mapping -> Acc (Vector e) -- ^input -> Acc (Vector e) -- ^output-gather mapV inputV = backpermute (shape mapV) bpF inputV+gather from input = backpermute (shape from) bpF input where- bpF ix = lift (Z :. (mapV ! ix))+ bpF ix = index1 (from ! ix) -- | Conditionally copy elements from source array to destination array according--- to a map. This is a backpermute operation where a 'map' vector encodes the--- output to input index mapping. In addition, there is a 'mask' vector, and an--- associated predication function, that specifies whether an element will be--- copied. If not copied, the output array assumes the default vector's value.+-- to an index mapping. This is a backpermute operation where a 'from' vector+-- encodes the output to input index mapping. In addition, there is a 'mask'+-- vector, and an associated predication function, that specifies whether an+-- element will be copied. If not copied, the output array assumes the default+-- vector's value. -- -- For example: -- -- > default = [6, 6, 6, 6, 6, 6]--- > map = [1, 3, 7, 2, 5, 3]+-- > from = [1, 3, 7, 2, 5, 3] -- > mask = [3, 4, 9, 2, 7, 5]--- > pred = (> 4)+-- > pred = (>* 4) -- > input = [1, 9, 6, 4, 4, 2, 0, 1, 2] -- > -- > output = [6, 6, 1, 6, 2, 4] -- gatherIf :: (Elt e, Elt e')- => Acc (Vector Int) -- ^map+ => Acc (Vector Int) -- ^index mapping -> Acc (Vector e) -- ^mask -> (Exp e -> Exp Bool) -- ^predicate -> Acc (Vector e') -- ^default -> Acc (Vector e') -- ^input -> Acc (Vector e') -- ^output-gatherIf mapV maskV pred defaultV inputV = zipWith zwF predV gatheredV+gatherIf from maskV pred defaults input = zipWith zf pf gatheredV where- zwF p g = p ? (unlift g)- gatheredV = zip (gather mapV inputV) defaultV- predV = map pred maskV+ zf p g = p ? (unlift g)+ gatheredV = zip (gather from input) defaults+ pf = map pred maskV -- Scatter operations -- ------------------ --- | Copy elements from source array to destination array according to a map. This--- is a forward-permute operation where a 'map' vector encodes an input to output--- index mapping. Output elements for indices that are not mapped assume the--- default vector's value.+-- | Copy elements from source array to destination array according to an index+-- mapping. This is a forward-permute operation where a 'to' vector encodes an+-- input to output index mapping. Output elements for indices that are not+-- mapped assume the default vector's value. -- -- For example: -- -- > default = [0, 0, 0, 0, 0, 0, 0, 0, 0]--- > map = [1, 3, 7, 2, 5, 8]+-- > to = [1, 3, 7, 2, 5, 8] -- > input = [1, 9, 6, 4, 4, 2, 5] -- > -- > output = [0, 1, 4, 9, 0, 4, 0, 6, 2] ----- Note if the same index appears in the map more than once, the result is--- undefined. The map vector cannot be larger than the input vector.+-- Note if the same index appears in the index mapping more than once, the+-- result is undefined. It does not makes sense for the 'to' vector to be+-- larger than the 'input' vector. ---scatter :: (Elt e)- => Acc (Vector Int) -- ^map+scatter :: Elt e+ => Acc (Vector Int) -- ^index mapping -> Acc (Vector e) -- ^default -> Acc (Vector e) -- ^input -> Acc (Vector e) -- ^output-scatter mapV defaultV inputV = permute (const) defaultV pF inputV+scatter to defaults input = permute const defaults pf input' where- pF ix = lift (Z :. (mapV ! ix))+ pf ix = index1 (to ! ix)+ input' = backpermute (shape to `intersect` shape input) id input -- | Conditionally copy elements from source array to destination array according--- to a map. This is a forward-permute operation where a 'map' vector encodes an--- input to output index mapping. In addition, there is a 'mask' vector, and an--- associated predicate function, that specifies whether an elements will be--- copied. If not copied, the output array assumes the default vector's value.+-- to an index mapping. This is a forward-permute operation where a 'to'+-- vector encodes an input to output index mapping. In addition, there is a+-- 'mask' vector, and an associated predicate function. The mapping will only+-- occur if the predicate function applied to the mask at that position+-- resolves to 'True'. If not copied, the output array assumes the default+-- vector's value. -- -- For example: -- -- > default = [0, 0, 0, 0, 0, 0, 0, 0, 0]--- > map = [1, 3, 7, 2, 5, 8]+-- > to = [1, 3, 7, 2, 5, 8] -- > mask = [3, 4, 9, 2, 7, 5]--- > pred = (> 4)--- > input = [1, 9, 6, 4, 4, 2]+-- > pred = (>* 4)+-- > input = [1, 9, 6, 4, 4, 2, 5] -- > -- > output = [0, 0, 0, 0, 0, 4, 0, 6, 2] ----- Note if the same index appears in the map more than once, the result is--- undefined. The map and input vector must be of the same length.+-- Note if the same index appears in the mapping more than once, the result is+-- undefined. The 'to' and 'mask' vectors must be the same length. It does not+-- make sense for these to be larger than the 'input' vector. -- scatterIf :: (Elt e, Elt e')- => Acc (Vector Int) -- ^map+ => Acc (Vector Int) -- ^index mapping -> Acc (Vector e) -- ^mask -> (Exp e -> Exp Bool) -- ^predicate -> Acc (Vector e') -- ^default -> Acc (Vector e') -- ^input -> Acc (Vector e') -- ^output-scatterIf mapV maskV pred defaultV inputV = permute const defaultV pF inputV+scatterIf to maskV pred defaults input = permute const defaults pf input' where- pF ix = (pred (maskV ! ix)) ? (lift (Z :. (mapV ! ix)), ignore)+ pf ix = pred (maskV ! ix) ? ( index1 (to ! ix), ignore )+ input' = backpermute (shape to `intersect` shape input) id input -- Permutations@@ -1098,7 +1106,7 @@ -- empty. -- init :: Elt e => Acc (Vector e) -> Acc (Vector e)-init arr = take ((unindex1 $ shape arr) - 1) arr+init arr = backpermute (ilift1 (subtract 1) (shape arr)) id arr -- | Yield all but the first element of the input vector. The vector must not be@@ -1137,7 +1145,17 @@ (?) :: Elt t => Exp Bool -> (Exp t, Exp t) -> Exp t c ? (t, e) = cond c t e +-- | A case-like control structure+--+caseof :: (Elt a, Elt b)+ => Exp a -- ^ case subject+ -> [(Exp a -> Exp Bool, Exp b)] -- ^ list of cases to attempt+ -> Exp b -- ^ default value+ -> Exp b+caseof _ [] e = e+caseof x ((p,b):l) e = cond (p x) b (caseof x l e) + -- Scalar iteration -- ---------------- @@ -1577,16 +1595,24 @@ -- Tuples -- ------ --- |Extract the first component of a pair.+-- |Extract the first component of a scalar pair. ---fst :: forall f a b. Unlift f (f a, f b) => f (Plain (f a), Plain (f b)) -> f a-fst e = let (x, _:: f b) = unlift e in x+fst :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp a+fst e = let (x, _::Exp b) = unlift e in x --- |Extract the second component of a pair.+-- |Extract the first component of an array pair.+afst :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc a+afst a = let (x, _::Acc b) = unlift a in x++-- |Extract the second component of a scalar pair. ---snd :: forall f a b. Unlift f (f a, f b) => f (Plain (f a), Plain (f b)) -> f b-snd e = let (_::f a, y) = unlift e in y+snd :: forall a b. (Elt a, Elt b) => Exp (a, b) -> Exp b+snd e = let (_:: Exp a, y) = unlift e in y +-- | Extract the second component of an array pair+asnd :: forall a b. (Arrays a, Arrays b) => Acc (a, b) -> Acc b+asnd a = let (_::Acc a, y) = unlift a in y+ -- |Converts an uncurried function to a curried function. -- curry :: Lift f (f a, f b) => (f (Plain (f a), Plain (f b)) -> f c) -> f a -> f b -> f c@@ -1645,4 +1671,9 @@ -- null :: (Shape ix, Elt e) => Acc (Array ix e) -> Exp Bool null arr = size arr ==* 0++-- |Get the length of a vector+--+length :: Elt e => Acc (Vector e) -> Exp Int+length = unindex1 . shape
Data/Array/Accelerate/Pretty.hs view
@@ -7,8 +7,9 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Pretty--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Pretty/Print.hs view
@@ -6,8 +6,9 @@ {-# LANGUAGE TypeOperators #-} -- | -- Module : Data.Array.Accelerate.Pretty.Print--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -143,7 +144,7 @@ prettyPreAfun pp alvl fun = let (n, bodyDoc) = count n fun in- char '\\' <> hsep [text $ 'a' : show idx | idx <- [0..n]] <+>+ char '\\' <> hsep [text $ 'a' : show idx | idx <- [alvl..alvl + n]] <+> text "->" <+> bodyDoc where count :: Int -> PreOpenAfun acc aenv' fun' -> (Int, Doc)
Data/Array/Accelerate/Smart.hs view
@@ -10,8 +10,10 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Smart--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell+-- [2013..2014] Robert Clifton-Everest -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -55,7 +57,7 @@ mkLAnd, mkLOr, mkLNot, -- * Smart constructors for type coercion functions- mkBoolToInt, mkFromIntegral,+ mkOrd, mkChr, mkBoolToInt, mkFromIntegral, -- * Auxiliary functions ($$), ($$$), ($$$$), ($$$$$),@@ -91,12 +93,6 @@ -- | Array-valued collective computations without a recursive knot ----- Note [Pipe and sharing recovery]--- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~--- The 'Pipe' constructor is special. It is the only form that contains functions over array--- computations and these functions are fixed to be over vanilla 'Acc' types. This enables us to--- perform sharing recovery independently from the context for them.--- data PreAcc acc exp as where -- Needed for conversion to de Bruijn form Atag :: Arrays as@@ -104,8 +100,8 @@ -> PreAcc acc exp as Pipe :: (Arrays as, Arrays bs, Arrays cs)- => (Acc as -> Acc bs) -- see comment above on why 'Acc' and not 'acc'- -> (Acc bs -> Acc cs)+ => (Acc as -> acc bs)+ -> (Acc bs -> acc cs) -> acc as -> PreAcc acc exp cs @@ -271,7 +267,7 @@ -- newtype Acc a = Acc (PreAcc Acc Exp a) -deriving instance Typeable1 Acc+deriving instance Typeable Acc -- Embedded expressions of the surface language@@ -388,7 +384,7 @@ -- newtype Exp t = Exp (PreExp Acc Exp t) -deriving instance Typeable1 Exp+deriving instance Typeable Exp -- Smart constructors and destructors for array tuples@@ -1004,14 +1000,20 @@ mkLNot :: Exp Bool -> Exp Bool mkLNot x = Exp $ PrimLNot `PrimApp` x --- FIXME: Character conversions+-- Character conversions --- FIXME: Numeric conversions+mkOrd :: Exp Char -> Exp Int+mkOrd x = Exp $ PrimOrd `PrimApp` x +mkChr :: Exp Int -> Exp Char+mkChr x = Exp $ PrimChr `PrimApp` x++-- Numeric conversions+ mkFromIntegral :: (Elt a, Elt b, IsIntegral a, IsNum b) => Exp a -> Exp b mkFromIntegral x = Exp $ PrimFromIntegral integralType numType `PrimApp` x --- FIXME: Other conversions+-- Other conversions mkBoolToInt :: Exp Bool -> Exp Int mkBoolToInt b = Exp $ PrimBoolToInt `PrimApp` b
Data/Array/Accelerate/Trafo.hs view
@@ -7,7 +7,7 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Trafo--- Copyright : [2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -32,10 +32,7 @@ ) where -import System.IO.Unsafe- import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Debug import Data.Array.Accelerate.Pretty ( ) -- show instances import Data.Array.Accelerate.Array.Sugar ( Arrays, Elt ) import Data.Array.Accelerate.Trafo.Base@@ -47,6 +44,11 @@ import qualified Data.Array.Accelerate.Trafo.Rewrite as Rewrite import qualified Data.Array.Accelerate.Trafo.Simplify as Rewrite import qualified Data.Array.Accelerate.Trafo.Sharing as Sharing++#ifdef ACCELERATE_DEBUG+import System.IO.Unsafe+import Data.Array.Accelerate.Debug+#endif -- Configuration
Data/Array/Accelerate/Trafo/Algebra.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Array.Accelerate.Trafo.Algebra--- Copyright : [2012..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Trafo/Base.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE IncoherentInstances #-}@@ -7,10 +6,11 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} -- | -- Module : Data.Array.Accelerate.Trafo.Base--- Copyright : [2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -41,12 +41,11 @@ -- friends import Data.Array.Accelerate.AST-import Data.Array.Accelerate.Array.Sugar ( Array, Arrays, Shape, Elt ) import Data.Array.Accelerate.Analysis.Match-import Data.Array.Accelerate.Trafo.Substitution+import Data.Array.Accelerate.Array.Sugar ( Array, Arrays, Shape, Elt )+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Pretty.Print--#include "accelerate.h"+import Data.Array.Accelerate.Trafo.Substitution -- Toolkit@@ -210,7 +209,7 @@ prjExp :: Idx env' t -> Gamma acc env env' aenv -> PreOpenExp acc env aenv t prjExp ZeroIdx (PushExp _ v) = v prjExp (SuccIdx ix) (PushExp env _) = prjExp ix env-prjExp _ _ = INTERNAL_ERROR(error) "prjExp" "inconsistent valuation"+prjExp _ _ = $internalError "prjExp" "inconsistent valuation" lookupExp :: Kit acc => Gamma acc env env' aenv -> PreOpenExp acc env aenv t -> Maybe (Idx env' t) lookupExp EmptyExp _ = Nothing
Data/Array/Accelerate/Trafo/Fusion.hs view
@@ -5,6 +5,7 @@ {-# LANGUAGE PatternGuards #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-}@@ -12,7 +13,7 @@ {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- | -- Module : Data.Array.Accelerate.Trafo.Fusion--- Copyright : [2012..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -45,6 +46,7 @@ -- friends import Data.Array.Accelerate.AST+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Trafo.Base import Data.Array.Accelerate.Trafo.Shrink import Data.Array.Accelerate.Trafo.Simplify@@ -58,9 +60,7 @@ import System.IO.Unsafe -- for debugging #endif -#include "accelerate.h" - -- Delayed Array Fusion -- ==================== @@ -121,7 +121,7 @@ -- manifest :: OpenAcc aenv a -> DelayedOpenAcc aenv a manifest (OpenAcc pacc) =- let fusionError = INTERNAL_ERROR(error) "manifest" "unexpected fusible materials"+ let fusionError = $internalError "manifest" "unexpected fusible materials" in Manifest $ case pacc of -- Non-fusible terms@@ -392,54 +392,14 @@ stencil x f a = Stencil f x a stencil2 x y f a b = Stencil2 f x a y b - -- Conversions for closed scalar functions and expressions, with- -- pre-simplification. We don't bother traversing array-valued terms in- -- scalar expressions, as these are guaranteed to only be array variables.+ -- Conversions for closed scalar functions and expressions. This just+ -- applies scalar simplifications. -- cvtF :: PreFun acc aenv t -> PreFun acc aenv t- cvtF = cvtF' . simplify+ cvtF = simplify cvtE :: PreExp acc aenv' t -> PreExp acc aenv' t- cvtE = cvtE' . simplify-- -- Conversions for scalar functions and expressions without- -- pre-simplification. Hence we can operate on open expressions.- --- cvtF' :: PreOpenFun acc env aenv' t -> PreOpenFun acc env aenv' t- cvtF' (Lam f) = Lam (cvtF' f)- cvtF' (Body b) = Body (cvtE' b)-- cvtE' :: PreOpenExp acc env aenv' t -> PreOpenExp acc env aenv' t- cvtE' exp =- case exp of- Let bnd body -> Let (cvtE' bnd) (cvtE' body)- Var ix -> Var ix- Const c -> Const c- Tuple tup -> Tuple (cvtT tup)- Prj tup ix -> Prj tup (cvtE' ix)- IndexNil -> IndexNil- IndexCons sh sz -> IndexCons (cvtE' sh) (cvtE' sz)- IndexHead sh -> IndexHead (cvtE' sh)- IndexTail sh -> IndexTail (cvtE' sh)- IndexAny -> IndexAny- IndexSlice x ix sh -> IndexSlice x (cvtE' ix) (cvtE' sh)- IndexFull x ix sl -> IndexFull x (cvtE' ix) (cvtE' sl)- ToIndex sh ix -> ToIndex (cvtE' sh) (cvtE' ix)- FromIndex sh ix -> FromIndex (cvtE' sh) (cvtE' ix)- Cond p t e -> Cond (cvtE' p) (cvtE' t) (cvtE' e)- While p f x -> While (cvtF' p) (cvtF' f) (cvtE' x)- PrimConst c -> PrimConst c- PrimApp f x -> PrimApp f (cvtE' x)- Index a sh -> Index a (cvtE' sh)- LinearIndex a i -> LinearIndex a (cvtE' i)- Shape a -> Shape a- ShapeSize sh -> ShapeSize (cvtE' sh)- Intersect s t -> Intersect (cvtE' s) (cvtE' t)- Foreign ff f e -> Foreign ff (cvtF' f) (cvtE' e)-- cvtT :: Tuple (PreOpenExp acc env aenv') t -> Tuple (PreOpenExp acc env aenv') t- cvtT NilTup = NilTup- cvtT (SnocTup tup e) = cvtT tup `SnocTup` cvtE' e+ cvtE = simplify -- Helpers to embed and fuse delayed terms --@@ -468,7 +428,7 @@ fuse2 op a1 a0 | Embed env1 cc1 <- embedAcc a1 , Embed env0 cc0 <- embedAcc (sink env1 a0)- , env <- env1 `join` env0+ , env <- env1 `append` env0 = Embed env (op env (sink env0 cc1) cc0) embed :: (Arrays as, Arrays bs)@@ -484,7 +444,7 @@ -> acc aenv bs -> Embed acc aenv cs embed2 op (embedAcc -> Embed env1 cc1) (embedAcc . sink env1 -> Embed env0 cc0)- | env <- env1 `join` env0+ | env <- env1 `append` env0 , acc1 <- inject . compute' $ sink env0 cc1 , acc0 <- inject . compute' $ cc0 = Embed (env `PushEnv` op env acc1 acc0) (Done ZeroIdx)@@ -507,7 +467,7 @@ -- are defined with respect to this existentially quantified type, and there is -- no way to directly combine these two environments: ----- join :: Extend env env1 -> Extend env env2 -> Extend env ???+-- append :: Extend env env1 -> Extend env env2 -> Extend env ??? -- -- And hence, no way to combine the terms of the delayed representation. --@@ -646,9 +606,9 @@ -- Append two environment witnesses ---join :: Extend acc env env' -> Extend acc env' env'' -> Extend acc env env''-join x BaseEnv = x-join x (PushEnv as a) = x `join` as `PushEnv` a+append :: Extend acc env env' -> Extend acc env' env'' -> Extend acc env env''+append x BaseEnv = x+append x (PushEnv as a) = x `append` as `PushEnv` a -- Bring into scope all of the array terms in the Extend environment list. This -- converts a term in the inner environment (aenv') into the outer (aenv).@@ -664,7 +624,7 @@ -- prjExtend :: Kit acc => Extend acc env env' -> Idx env' t -> PreOpenAcc acc env' t -- prjExtend (PushEnv _ v) ZeroIdx = weakenA rebuildAcc SuccIdx v -- prjExtend (PushEnv env _) (SuccIdx idx) = weakenA rebuildAcc SuccIdx $ prjExtend env idx--- prjExtend _ _ = INTERNAL_ERROR(error) "prjExtend" "inconsistent valuation"+-- prjExtend _ _ = $internalError "prjExtend" "inconsistent valuation" -- Sink a term from one array environment into another, where additional@@ -992,7 +952,7 @@ | Done v1 <- cc1 , Embed env0 cc0 <- embedAcc $ rebuildAcc (subAtop (Avar v1) . sink1 env1) acc0 = Stats.ruleFired "aletD/float"- $ Embed (env1 `join` env0) cc0+ $ Embed (env1 `append` env0) cc0 -- Ensure we only call 'embedAcc' once on the body expression --@@ -1019,7 +979,7 @@ | acc1 <- compute (Embed env1 cc1) , False <- elimAcc (inject acc1) acc0 = Stats.ruleFired "aletD/bind"- $ Embed (BaseEnv `PushEnv` acc1 `join` env0) cc0+ $ Embed (BaseEnv `PushEnv` acc1 `append` env0) cc0 -- let-elimination -- ---------------@@ -1034,6 +994,7 @@ Yield{} -> eliminate env1 cc1 acc0' where+ acc0 :: acc (aenv, arrs) brrs acc0 = computeAcc (Embed env0 cc0) -- The second part of let-elimination. Splitting into two steps exposes the@@ -1058,7 +1019,7 @@ | sh1' <- weakenEA rebuildAcc SuccIdx sh1 , f1' <- weakenFA rebuildAcc SuccIdx f1 , Embed env0' cc0' <- embedAcc $ rebuildAcc (subAtop bnd) $ kmap (replaceA sh1' f1' ZeroIdx) body- = Embed (env1 `join` env0') cc0'+ = Embed (env1 `append` env0') cc0' -- As part of let-elimination, we need to replace uses of array variables in -- scalar expressions with an equivalent expression that generates the@@ -1151,8 +1112,8 @@ Acond p at ae -> Acond (cvtE p) (cvtA at) (cvtA ae) Aprj ix tup -> Aprj ix (cvtA tup) Atuple tup -> Atuple (cvtAT tup)- Awhile p f a -> Awhile p f (cvtA a) -- no sharing between p or f and a- Apply f a -> Apply f (cvtA a) -- no sharing between f and a+ Awhile p f a -> Awhile (cvtAF p) (cvtAF f) (cvtA a)+ Apply f a -> Apply (cvtAF f) (cvtA a) Aforeign ff f a -> Aforeign ff f (cvtA a) -- no sharing between f and a Generate sh f -> Generate (cvtE sh) (cvtF f) Map f a -> Map (cvtF f) (cvtA a)@@ -1179,6 +1140,19 @@ where cvtA :: acc aenv s -> acc aenv s cvtA = kmap (replaceA sh' f' avar)++ cvtAF :: PreOpenAfun acc aenv s -> PreOpenAfun acc aenv s+ cvtAF = cvt sh' f' avar+ where+ cvt :: forall aenv a.+ PreExp acc aenv sh -> PreFun acc aenv (sh -> e) -> Idx aenv (Array sh e)+ -> PreOpenAfun acc aenv a+ -> PreOpenAfun acc aenv a+ cvt sh'' f'' avar' (Abody a) = Abody $ kmap (replaceA sh'' f'' avar') a+ cvt sh'' f'' avar' (Alam af) = Alam $ cvt (weakenEA rebuildAcc SuccIdx sh'')+ (weakenFA rebuildAcc SuccIdx f'')+ (SuccIdx avar')+ af cvtE :: PreExp acc aenv s -> PreExp acc aenv s cvtE = replaceE sh' f' avar
Data/Array/Accelerate/Trafo/Rewrite.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} -- | -- Module : Data.Array.Accelerate.Trafo.Rewrite--- Copyright : [2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Trafo/Sharing.hs view
@@ -1,16 +1,17 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Trafo.Sharing--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2009..2014] Trevor L. McDonell+-- [2013..2014] Robert Clifton-Everest -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -44,6 +45,7 @@ import System.Mem.StableName -- friends+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Smart import Data.Array.Accelerate.Array.Sugar as Sugar import Data.Array.Accelerate.Tuple hiding ( Tuple )@@ -54,9 +56,7 @@ import qualified Data.Array.Accelerate.Tuple as Tuple import qualified Data.Array.Accelerate.Debug as Debug -#include "accelerate.h" - -- Configuration -- ------------- @@ -213,7 +213,7 @@ = error $ "Cyclic definition of a value of type 'Acc' (sa = " ++ show (hashStableNameHeight sa) ++ ")" | otherwise- = INTERNAL_ERROR(error) "convertSharingAcc" err+ = $internalError "convertSharingAcc" err where aenv' = lams ++ aenv ctxt = "shared 'Acc' tree with stable name " ++ show (hashStableNameHeight sa)@@ -244,10 +244,7 @@ cvtF2 = convertSharingFun2 config alyt aenv' cvtAfun1 :: (Arrays a, Arrays b) => (Acc a -> ScopedAcc b) -> AST.OpenAfun aenv (a -> b)- cvtAfun1 f = Alam (Abody (convertSharingAcc config alyt' aenv' body))- where- alyt' = incLayout alyt `PushLayout` ZeroIdx- body = f undefined+ cvtAfun1 = convertSharingAfun1 config alyt aenv' in case preAcc of @@ -255,9 +252,12 @@ -> AST.Avar (prjIdx ("de Bruijn conversion tag " ++ show i) i alyt) Pipe afun1 afun2 acc- -> let alyt' = incLayout alyt `PushLayout` ZeroIdx- boundAcc = aconvert config alyt afun1 `AST.Apply` convertSharingAcc config alyt aenv' acc- bodyAcc = aconvert config alyt' afun2 `AST.Apply` AST.OpenAcc (AST.Avar AST.ZeroIdx)+ -> let noStableSharing = StableSharingAcc noStableAccName (undefined :: SharingAcc acc exp ())+ alyt' = incLayout alyt `PushLayout` ZeroIdx+ boundAcc = cvtAfun1 afun1 `AST.Apply` cvtA acc+ bodyAcc = convertSharingAfun1 config alyt' (noStableSharing : aenv') afun2+ `AST.Apply`+ AST.OpenAcc (AST.Avar AST.ZeroIdx) in AST.Alet (AST.OpenAcc boundAcc) (AST.OpenAcc bodyAcc) @@ -303,6 +303,19 @@ (convertBoundary bndy2) (cvtA acc2) +convertSharingAfun1+ :: forall aenv a b. (Arrays a, Arrays b)+ => Config+ -> Layout aenv aenv+ -> [StableSharingAcc]+ -> (Acc a -> ScopedAcc b)+ -> OpenAfun aenv (a -> b)+convertSharingAfun1 config alyt aenv f+ = Alam (Abody (convertSharingAcc config alyt' aenv body))+ where+ alyt' = incLayout alyt `PushLayout` ZeroIdx+ body = f undefined+ convertSharingAtuple :: forall aenv a. Config@@ -444,7 +457,7 @@ | null env' = error $ "Cyclic definition of a value of type 'Exp' (sa = " ++ show (hashStableNameHeight se) ++ ")" | otherwise- = INTERNAL_ERROR(error) "convertSharingExp" err+ = $internalError "convertSharingExp" err where ctxt = "shared 'Exp' tree with stable name " ++ show (hashStableNameHeight se) err = "inconsistent valuation @ " ++ ctxt ++ ";\n env' = " ++ show env'@@ -668,7 +681,7 @@ -- Opaque stable name for AST nodes — used to key the occurrence map. -- data StableASTName c where- StableASTName :: (Typeable1 c, Typeable t) => StableName (c t) -> StableASTName c+ StableASTName :: (Typeable c, Typeable t) => StableName (c t) -> StableASTName c instance Show (StableASTName c) where show (StableASTName sn) = show $ hashStableName sn@@ -1001,7 +1014,12 @@ case pacc of Atag i -> reconstruct $ return (Atag i, 0) -- height is 0!- Pipe afun1 afun2 acc -> reconstruct $ travA (Pipe afun1 afun2) acc+ Pipe afun1 afun2 acc -> reconstruct $ do+ (afun1', h1) <- traverseAfun1 lvl afun1+ (afun2', h2) <- traverseAfun1 lvl afun2+ (acc', h3) <- traverseAcc lvl acc+ return (Pipe afun1' afun2' acc'+ , h1 `max` h2 `max` h3 + 1) Aforeign ff afun acc -> reconstruct $ travA (Aforeign ff afun) acc Acond e acc1 acc2 -> reconstruct $ do (e' , h1) <- traverseExp lvl e@@ -1524,12 +1542,12 @@ = case filter hasTag sas of [] -> noStableSharing -- tag is not used in the analysed expression [sa] -> sa -- tag has a unique occurrence- sas2 -> INTERNAL_ERROR(error) "buildInitialEnvAcc"+ sas2 -> $internalError "buildInitialEnvAcc" $ "Encountered duplicate 'ATag's\n " ++ intercalate ", " (map showSA sas2) where hasTag (StableSharingAcc _ (AccSharing _ (Atag tag2))) = tag1 == tag2 hasTag sa- = INTERNAL_ERROR(error) "buildInitialEnvAcc"+ = $internalError "buildInitialEnvAcc" $ "Encountered a node that is not a plain 'Atag'\n " ++ showSA sa noStableSharing :: StableSharingAcc@@ -1555,12 +1573,12 @@ = case filter hasTag ses of [] -> noStableSharing -- tag is not used in the analysed expression [se] -> se -- tag has a unique occurrence- ses2 -> INTERNAL_ERROR(error) "buildInitialEnvExp"+ ses2 -> $internalError "buildInitialEnvExp" ("Encountered a duplicate 'Tag'\n " ++ intercalate ", " (map showSE ses2)) where hasTag (StableSharingExp _ (ExpSharing _ (Tag tag2))) = tag1 == tag2 hasTag se- = INTERNAL_ERROR(error) "buildInitialEnvExp"+ = $internalError "buildInitialEnvExp" ("Encountered a node that is not a plain 'Tag'\n " ++ showSE se) noStableSharing :: StableSharingExp@@ -1606,7 +1624,7 @@ in if all isFreeVar counts then (sharingAcc, buildInitialEnvAcc fvs [sa | AccNodeCount sa _ <- counts])- else INTERNAL_ERROR(error) "determineScopesAcc" ("unbound shared subtrees" ++ show unboundTrees)+ else $internalError "determineScopesAcc" ("unbound shared subtrees" ++ show unboundTrees) determineScopesSharingAcc@@ -1618,7 +1636,7 @@ where scopesAcc :: forall arrs. UnscopedAcc arrs -> (ScopedAcc arrs, NodeCounts) scopesAcc (UnscopedAcc _ (AletSharing _ _))- = INTERNAL_ERROR(error) "determineScopesSharingAcc: scopesAcc" "unexpected 'AletSharing'"+ = $internalError "determineScopesSharingAcc: scopesAcc" "unexpected 'AletSharing'" scopesAcc (UnscopedAcc _ (AvarSharing sn)) = (ScopedAcc [] (AvarSharing sn), StableSharingAcc sn (AvarSharing sn) `insertAccNode` noNodeCounts)@@ -1626,8 +1644,14 @@ scopesAcc (UnscopedAcc _ (AccSharing sn pacc)) = case pacc of Atag i -> reconstruct (Atag i) noNodeCounts- Pipe afun1 afun2 acc -> travA (Pipe afun1 afun2) acc- -- we are not traversing 'afun1' & 'afun2' — see Note [Pipe and sharing recovery]+ Pipe afun1 afun2 acc -> let+ (afun1', accCount1) = scopesAfun1 afun1+ (afun2', accCount2) = scopesAfun1 afun2+ (acc', accCount3) = scopesAcc acc+ in+ reconstruct (Pipe afun1' afun2' acc')+ (accCount1 +++ accCount2 +++ accCount3)+ Aforeign ff afun acc -> let (acc', accCount) = scopesAcc acc in@@ -1961,7 +1985,7 @@ scopesExp :: forall t. UnscopedExp t -> (ScopedExp t, NodeCounts) scopesExp (UnscopedExp _ (LetSharing _ _))- = INTERNAL_ERROR(error) "determineScopesSharingExp: scopesExp" "unexpected 'LetSharing'"+ = $internalError "determineScopesSharingExp: scopesExp" "unexpected 'LetSharing'" scopesExp (UnscopedExp _ (VarSharing sn)) = (ScopedExp [] (VarSharing sn), StableSharingExp sn (VarSharing sn) `insertExpNode` noNodeCounts)@@ -2059,7 +2083,7 @@ abstract :: ScopedAcc a -> (ScopedAcc a -> SharingAcc ScopedAcc ScopedExp a) -> (ScopedAcc a, StableSharingAcc)- abstract (ScopedAcc _ (AvarSharing _)) _ = INTERNAL_ERROR(error) "sharingAccToVar" "AvarSharing"+ abstract (ScopedAcc _ (AvarSharing _)) _ = $internalError "sharingAccToVar" "AvarSharing" abstract (ScopedAcc ssa (AletSharing sa acc)) lets = abstract acc (lets . (\x -> ScopedAcc ssa (AletSharing sa x))) abstract acc@(ScopedAcc ssa (AccSharing sn _)) lets = (ScopedAcc ssa (AvarSharing sn), StableSharingAcc sn (lets acc))
Data/Array/Accelerate/Trafo/Shrink.hs view
@@ -5,7 +5,7 @@ {-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Array.Accelerate.Trafo.Shrink--- Copyright : [2012..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -287,7 +287,7 @@ IndexAny -> 0 ToIndex sh ix -> countE sh + countE ix FromIndex sh i -> countE sh + countE i- Cond p t e -> countE p + countE t `max` countE e+ Cond p t e -> countE p + countE t + countE e While p f x -> countE x + countF idx p + countF idx f PrimConst _ -> 0 PrimApp _ x -> countE x@@ -333,7 +333,7 @@ Aprj _ a -> countA a -- special case discount? Apply _ a -> countA a Aforeign _ _ a -> countA a- Acond p t e -> countE p + countA t `max` countA e+ Acond p t e -> countE p + countA t + countA e Awhile _ _ a -> countA a Use _ -> 0 Unit e -> countE e
Data/Array/Accelerate/Trafo/Simplify.hs view
@@ -1,14 +1,14 @@ {-# LANGUAGE BangPatterns #-}-{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} -- | -- Module : Data.Array.Accelerate.Trafo.Simplify--- Copyright : [2012..2013] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -32,7 +32,7 @@ -- friends import Data.Array.Accelerate.AST hiding ( prj )--- import Data.Array.Accelerate.Type+import Data.Array.Accelerate.Error import Data.Array.Accelerate.Tuple import Data.Array.Accelerate.Analysis.Match import Data.Array.Accelerate.Trafo.Base@@ -45,9 +45,7 @@ import Data.Array.Accelerate.Pretty.Print import qualified Data.Array.Accelerate.Debug as Stats -#include "accelerate.h" - class Simplify f where simplify :: f -> f @@ -309,11 +307,13 @@ indexCons sl sz = IndexCons <$> sl <*> sz - indexHead :: (Slice sl, Elt sz) => (Any, PreOpenExp acc env aenv (sl :. sz)) -> (Any, PreOpenExp acc env aenv sz)+ indexHead :: forall sl sz. (Slice sl, Elt sz) => (Any, PreOpenExp acc env aenv (sl :. sz)) -> (Any, PreOpenExp acc env aenv sz)+ indexHead (_, Const c) = let _ :. sz = toElt c :: (sl :. sz) in yes (Const (fromElt sz)) indexHead (_, IndexCons _ sz) = yes sz indexHead sh = IndexHead <$> sh - indexTail :: (Slice sl, Elt sz) => (Any, PreOpenExp acc env aenv (sl :. sz)) -> (Any, PreOpenExp acc env aenv sl)+ indexTail :: forall sl sz. (Slice sl, Elt sz) => (Any, PreOpenExp acc env aenv (sl :. sz)) -> (Any, PreOpenExp acc env aenv sl)+ indexTail (_, Const c) = let sl :. _ = toElt c :: (sl :. sz) in yes (Const (fromElt sl)) indexTail (_, IndexCons sl _) = yes sl indexTail sh = IndexTail <$> sh @@ -385,7 +385,7 @@ fix :: Int -> f a -> f a fix !i !x0- | i >= lIMIT = INTERNAL_CHECK(warning) "iterate" "iteration limit reached" (x0 ==^ f x0) x0+ | i >= lIMIT = $internalWarning "iterate" "iteration limit reached" (x0 ==^ f x0) x0 | not shrunk = x1 | not simplified = x2 | otherwise = fix (i+1) x2
Data/Array/Accelerate/Trafo/Substitution.hs view
@@ -6,7 +6,7 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Trafo.Substitution--- Copyright : [2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2012..2014] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -133,22 +133,25 @@ -- type env :> env' = forall t'. Idx env t' -> Idx env' t' +{-# NOINLINE[1] weakenA #-} weakenA :: RebuildAcc acc -> aenv :> aenv' -> PreOpenAcc acc aenv a -> PreOpenAcc acc aenv' a weakenA k v = Stats.substitution "weakenA" . rebuildA k (Avar . v) +{-# NOINLINE[1] weakenEA #-} weakenEA :: RebuildAcc acc -> aenv :> aenv' -> PreOpenExp acc env aenv t -> PreOpenExp acc env aenv' t weakenEA k v = Stats.substitution "weakenEA" . rebuildEA k (Avar . v) +{-# NOINLINE[1] weakenFA #-} weakenFA :: RebuildAcc acc -> aenv :> aenv' -> PreOpenFun acc env aenv f -> PreOpenFun acc env aenv' f weakenFA k v = Stats.substitution "weakenFA" . rebuildFA k (Avar . v) -+{-# NOINLINE[1] weakenE #-} weakenE :: env :> env' -> PreOpenExp acc env aenv t -> PreOpenExp acc env' aenv t weakenE v = Stats.substitution "weakenE" . rebuildE (Var . v) +{-# NOINLINE[1] weakenFE #-} weakenFE :: env :> env' -> PreOpenFun acc env aenv f -> PreOpenFun acc env' aenv f weakenFE v = Stats.substitution "weakenFE" . rebuildFE (Var . v)- {-# RULES "weakenA/weakenA" forall a (k :: RebuildAcc acc) (v1 :: env' :> env'') (v2 :: env :> env').
Data/Array/Accelerate/Tuple.hs view
@@ -4,8 +4,9 @@ {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Tuple--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>
Data/Array/Accelerate/Type.hs view
@@ -1,13 +1,16 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-} -- | -- Module : Data.Array.Accelerate.Type--- Copyright : [2008..2011] Manuel M T Chakravarty, Gabriele Keller, Sean Lee--- [2009..2012] Manuel M T Chakravarty, Gabriele Keller, Trevor L. McDonell+-- Copyright : [2008..2014] Manuel M T Chakravarty, Gabriele Keller+-- [2008..2009] Sean Lee+-- [2009..2014] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Manuel M T Chakravarty <chak@cse.unsw.edu.au>@@ -50,41 +53,8 @@ -- Extend Typeable support for 8- and 9-tuple -- ------------------------------------------ -myMkTyCon :: String -> TyCon-myMkTyCon = mkTyCon3 "accelerate" "Data.Array.Accelerate.Type"--class Typeable8 t where- typeOf8 :: t a b c d e f g h -> TypeRep--instance Typeable8 (,,,,,,,) where- typeOf8 _ = myMkTyCon "(,,,,,,,)" `mkTyConApp` []--typeOf7Default :: (Typeable8 t, Typeable a) => t a b c d e f g h -> TypeRep-typeOf7Default x = typeOf8 x `mkAppTy` typeOf (argType x)- where- argType :: t a b c d e f g h -> a- argType = undefined--instance (Typeable8 s, Typeable a)- => Typeable7 (s a) where- typeOf7 = typeOf7Default- -class Typeable9 t where- typeOf9 :: t a b c d e f g h i -> TypeRep--instance Typeable9 (,,,,,,,,) where- typeOf9 _ = myMkTyCon "(,,,,,,,,)" `mkTyConApp` []--typeOf8Default :: (Typeable9 t, Typeable a) => t a b c d e f g h i -> TypeRep-typeOf8Default x = typeOf9 x `mkAppTy` typeOf (argType x)- where- argType :: t a b c d e f g h i -> a- argType = undefined--instance (Typeable9 s, Typeable a)- => Typeable8 (s a) where- typeOf8 = typeOf8Default-+deriving instance Typeable (,,,,,,,)+deriving instance Typeable (,,,,,,,,) -- Scalar types
− INSTALL
@@ -1,20 +0,0 @@-Requirements: -- Glasgow Haskell Compiler (GHC), 7.0.3 or later-- Haskell libraries as specified in 'accelerate.cabal'-- For the CUDA backend, CUDA version 3.0 or later--Standard Cabal installation:-- % runhaskell Setup.hs configure --prefix=INSTALLPATH- % runhaskell Setup.hs build- % runhaskell Setup.hs install- OR- runhaskell Setup.hs install -- user--Then, to use the library, pass the flag "-package accelerate" to GHC.--The source repository is at https://github.com/mchakravarty/accelerate-The project web page is at http://www.cse.unsw.edu.au/~chak/project/accelerate/--Direct questions at Manuel M T Chakravarty <chak@cse.unsw.edu.au>-(aka TacticalGrace on #haskell and friends).
Setup.hs view
@@ -1,20 +1,3 @@-#! /usr/bin/env runhaskell--import Control.Monad import Distribution.Simple-import Distribution.Simple.Setup-import Distribution.Simple.Utils-import System.Directory--main :: IO ()-main = defaultMainWithHooks autoconfUserHooks { preConf = preConfHook }- where- preConfHook args flags = do- let verbosity = fromFlag (configVerbosity flags)-- confExists <- doesFileExist "configure"- unless confExists $- rawSystemExit verbosity "autoconf" []-- preConf autoconfUserHooks args flags+main = defaultMain
− accelerate.buildinfo.in
@@ -1,3 +0,0 @@-ghc-options: @ghc_flags@-cc-options: @cpp_flags@-
accelerate.cabal view
@@ -1,8 +1,8 @@ Name: accelerate-Version: 0.14.0.0-Cabal-version: >= 1.6-Tested-with: GHC == 7.6.*-Build-type: Custom+Version: 0.15.0.0+Cabal-version: >= 1.8+Tested-with: GHC == 7.8.*+Build-type: Simple Synopsis: An embedded language for accelerated array processing @@ -37,7 +37,8 @@ <http://hackage.haskell.org/package/accelerate-cuda> . Several experimental and/or incomplete backends also exist. If you are- interested in helping finish these, please contact us.+ particularly interested in any of these, especially with helping to finish+ them, please contact us. . 1. Cilk\/ICC and OpenCL: <https://github.com/AccelerateHS/accelerate-backend-kit> .@@ -45,13 +46,16 @@ . 3. A backend to the Repa array library: <https://github.com/blambo/accelerate-repa> .+ 4. An infrastructure for generating LLVM code, with backends targeting+ multicore CPUs and NVIDIA GPUs: <https://github.com/AccelerateHS/accelerate-llvm/>+ . [/Additional components/] . The following support packages are available: . 1. @accelerate-cuda@: A high-performance parallel backend targeting CUDA-enabled NVIDIA GPUs. Requires the NVIDIA CUDA SDK and, for full- functionality, hardware with compute capability 1.2 or greater. See the+ functionality, hardware with compute capability 1.1 or greater. See the table on Wikipedia for supported GPUs: <http://en.wikipedia.org/wiki/CUDA#Supported_GPUs> .@@ -59,7 +63,7 @@ /Accelerate/, as well as performance and regression tests. . 3. @accelerate-io@: Fast conversion between /Accelerate/ arrays and other- formats, including Repa arrays.+ formats, including 'vector' and 'repa'. . 4. @accelerate-fft@: Computation of Discrete Fourier Transforms. .@@ -85,6 +89,8 @@ . * A \"password recovery\" tool, for dictionary lookup of MD5 hashes .+ * A simple interactive ray tracer+ . [/Mailing list and contacts/] . * Mailing list: <accelerate-haskell@googlegroups.com> (discussion of both@@ -98,8 +104,11 @@ . [/Release notes/] .+ * /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. Bug fixes.+ Improved code generation and fusion optimisation. Concurrent kernel+ execution. Bug fixes. . * /0.13.0.0:/ New array fusion optimisation. New foreign function interface for array and scalar expressions. Additional Prelude-like@@ -131,15 +140,6 @@ . * /0.7.1.0:/ The CUDA backend and a number of scalar functions. .- [/Hackage note/]- .- The module documentation list generated by Hackage is incorrect. The only- exposed modules should be:- .- * "Data.Array.Accelerate"- .- * "Data.Array.Accelerate.Interpreter"- . License: BSD3 License-file: LICENSE@@ -158,17 +158,8 @@ Category: Compilers/Interpreters, Concurrency, Data, Parallelism Stability: Experimental -Extra-tmp-files: config.status- config.log- autom4te.cache- accelerate.buildinfo--Extra-source-files: INSTALL- configure- accelerate.buildinfo.in- include/accelerate.h- Flag debug+ Default: False Description: Enable tracing message flags. These are read from the command-line arguments, which is convenient but may cause problems interacting with the@@ -200,28 +191,36 @@ Default: False Library- Include-Dirs: include- Build-depends: array >= 0.3,- base == 4.6.*,- containers >= 0.3,- unordered-containers >= 0.2 && < 0.3,- fclabels >= 2.0 && < 2.1,- ghc-prim >= 0.2,- hashable >= 1.1 && < 1.3,- hashtables >= 1.0 && < 1.2,- pretty >= 1.0+ Build-depends: array >= 0.3,+ base == 4.7.*,+ containers >= 0.3,+ unordered-containers >= 0.2,+ fclabels >= 2.0,+ ghc-prim >= 0.2,+ hashable >= 1.1,+ hashtables >= 1.0,+ pretty >= 1.0,+ template-haskell == 2.9.* if flag(more-pp)- Build-depends: bytestring >= 0.9,- blaze-html >= 0.5,- blaze-markup >= 0.5,- directory >= 1.0,- filepath >= 1.0,- mtl >= 2.0,- text >= 0.10,- unix >= 2.4+ Build-depends: bytestring >= 0.9,+ blaze-html >= 0.5,+ blaze-markup >= 0.5,+ directory >= 1.0,+ filepath >= 1.0,+ mtl >= 2.0,+ text >= 0.10,+ unix >= 2.4 - Exposed-modules: Data.Array.Accelerate+ Exposed-modules:+ -- The core language and reference implementation+ Data.Array.Accelerate+ Data.Array.Accelerate.Interpreter++ -- Prelude-like+ Data.Array.Accelerate.Data.Complex++ -- For backend development Data.Array.Accelerate.AST Data.Array.Accelerate.Analysis.Match Data.Array.Accelerate.Analysis.Shape@@ -231,17 +230,14 @@ Data.Array.Accelerate.Array.Representation Data.Array.Accelerate.Array.Sugar Data.Array.Accelerate.Debug- Data.Array.Accelerate.Interpreter+ Data.Array.Accelerate.Error Data.Array.Accelerate.Pretty Data.Array.Accelerate.Smart Data.Array.Accelerate.Trafo- Data.Array.Accelerate.Trafo.Sharing Data.Array.Accelerate.Tuple Data.Array.Accelerate.Type - Other-modules: Data.Array.Accelerate.Array.Delayed- Data.Array.Accelerate.Internal.Check- Data.Array.Accelerate.Language+ Other-modules: Data.Array.Accelerate.Language Data.Array.Accelerate.Prelude Data.Array.Accelerate.Pretty.Print Data.Array.Accelerate.Pretty.Traverse@@ -249,6 +245,7 @@ Data.Array.Accelerate.Trafo.Base Data.Array.Accelerate.Trafo.Fusion Data.Array.Accelerate.Trafo.Rewrite+ Data.Array.Accelerate.Trafo.Sharing Data.Array.Accelerate.Trafo.Shrink Data.Array.Accelerate.Trafo.Simplify Data.Array.Accelerate.Trafo.Substitution
− configure
@@ -1,2943 +0,0 @@-#! /bin/sh-# Guess values for system-dependent variables and create Makefiles.-# Generated by GNU Autoconf 2.69 for accelerate 0.14.0.0.-#-# Report bugs to <accelerate-haskell@googlegroups.com>.-#-#-# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.-#-#-# This configure script is free software; the Free Software Foundation-# gives unlimited permission to copy, distribute and modify it.-## -------------------- ##-## M4sh Initialization. ##-## -------------------- ##--# Be more Bourne compatible-DUALCASE=1; export DUALCASE # for MKS sh-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :- emulate sh- NULLCMD=:- # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which- # is contrary to our usage. Disable this feature.- alias -g '${1+"$@"}'='"$@"'- setopt NO_GLOB_SUBST-else- case `(set -o) 2>/dev/null` in #(- *posix*) :- set -o posix ;; #(- *) :- ;;-esac-fi---as_nl='-'-export as_nl-# Printing a long string crashes Solaris 7 /usr/bin/printf.-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo-# Prefer a ksh shell builtin over an external printf program on Solaris,-# but without wasting forks for bash or zsh.-if test -z "$BASH_VERSION$ZSH_VERSION" \- && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then- as_echo='print -r --'- as_echo_n='print -rn --'-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then- as_echo='printf %s\n'- as_echo_n='printf %s'-else- if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then- as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'- as_echo_n='/usr/ucb/echo -n'- else- as_echo_body='eval expr "X$1" : "X\\(.*\\)"'- as_echo_n_body='eval- arg=$1;- case $arg in #(- *"$as_nl"*)- expr "X$arg" : "X\\(.*\\)$as_nl";- arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;- esac;- expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"- '- export as_echo_n_body- as_echo_n='sh -c $as_echo_n_body as_echo'- fi- export as_echo_body- as_echo='sh -c $as_echo_body as_echo'-fi--# The user is always right.-if test "${PATH_SEPARATOR+set}" != set; then- PATH_SEPARATOR=:- (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {- (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||- PATH_SEPARATOR=';'- }-fi---# IFS-# We need space, tab and new line, in precisely that order. Quoting is-# there to prevent editors from complaining about space-tab.-# (If _AS_PATH_WALK were called with IFS unset, it would disable word-# splitting by setting IFS to empty value.)-IFS=" "" $as_nl"--# Find who we are. Look in the path if we contain no directory separator.-as_myself=-case $0 in #((- *[\\/]* ) as_myself=$0 ;;- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do- IFS=$as_save_IFS- test -z "$as_dir" && as_dir=.- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break- done-IFS=$as_save_IFS-- ;;-esac-# We did not find ourselves, most probably we were run as `sh COMMAND'-# in which case we are not to be found in the path.-if test "x$as_myself" = x; then- as_myself=$0-fi-if test ! -f "$as_myself"; then- $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2- exit 1-fi--# Unset variables that we do not need and which cause bugs (e.g. in-# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"-# suppresses any "Segmentation fault" message there. '((' could-# trigger a bug in pdksh 5.2.14.-for as_var in BASH_ENV ENV MAIL MAILPATH-do eval test x\${$as_var+set} = xset \- && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :-done-PS1='$ '-PS2='> '-PS4='+ '--# NLS nuisances.-LC_ALL=C-export LC_ALL-LANGUAGE=C-export LANGUAGE--# CDPATH.-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH--# Use a proper internal environment variable to ensure we don't fall- # into an infinite loop, continuously re-executing ourselves.- if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then- _as_can_reexec=no; export _as_can_reexec;- # We cannot yet assume a decent shell, so we have to provide a-# neutralization value for shells without unset; and this also-# works around shells that cannot unset nonexistent variables.-# Preserve -v and -x to the replacement shell.-BASH_ENV=/dev/null-ENV=/dev/null-(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV-case $- in # ((((- *v*x* | *x*v* ) as_opts=-vx ;;- *v* ) as_opts=-v ;;- *x* ) as_opts=-x ;;- * ) as_opts= ;;-esac-exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}-# Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.-$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2-as_fn_exit 255- fi- # We don't want this to propagate to other subprocesses.- { _as_can_reexec=; unset _as_can_reexec;}-if test "x$CONFIG_SHELL" = x; then- as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :- emulate sh- NULLCMD=:- # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which- # is contrary to our usage. Disable this feature.- alias -g '\${1+\"\$@\"}'='\"\$@\"'- setopt NO_GLOB_SUBST-else- case \`(set -o) 2>/dev/null\` in #(- *posix*) :- set -o posix ;; #(- *) :- ;;-esac-fi-"- as_required="as_fn_return () { (exit \$1); }-as_fn_success () { as_fn_return 0; }-as_fn_failure () { as_fn_return 1; }-as_fn_ret_success () { return 0; }-as_fn_ret_failure () { return 1; }--exitcode=0-as_fn_success || { exitcode=1; echo as_fn_success failed.; }-as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; }-as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; }-as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; }-if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :--else- exitcode=1; echo positional parameters were not saved.-fi-test x\$exitcode = x0 || exit 1-test -x / || exit 1"- as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO- as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO- eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&- test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1"- if (eval "$as_required") 2>/dev/null; then :- as_have_required=yes-else- as_have_required=no-fi- if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then :--else- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-as_found=false-for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH-do- IFS=$as_save_IFS- test -z "$as_dir" && as_dir=.- as_found=:- case $as_dir in #(- /*)- for as_base in sh bash ksh sh5; do- # Try only shells that exist, to save several forks.- as_shell=$as_dir/$as_base- if { test -f "$as_shell" || test -f "$as_shell.exe"; } &&- { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then :- CONFIG_SHELL=$as_shell as_have_required=yes- if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then :- break 2-fi-fi- done;;- esac- as_found=false-done-$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } &&- { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then :- CONFIG_SHELL=$SHELL as_have_required=yes-fi; }-IFS=$as_save_IFS--- if test "x$CONFIG_SHELL" != x; then :- export CONFIG_SHELL- # We cannot yet assume a decent shell, so we have to provide a-# neutralization value for shells without unset; and this also-# works around shells that cannot unset nonexistent variables.-# Preserve -v and -x to the replacement shell.-BASH_ENV=/dev/null-ENV=/dev/null-(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV-case $- in # ((((- *v*x* | *x*v* ) as_opts=-vx ;;- *v* ) as_opts=-v ;;- *x* ) as_opts=-x ;;- * ) as_opts= ;;-esac-exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}-# Admittedly, this is quite paranoid, since all the known shells bail-# out after a failed `exec'.-$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2-exit 255-fi-- if test x$as_have_required = xno; then :- $as_echo "$0: This script requires a shell more modern than all"- $as_echo "$0: the shells that I found on your system."- if test x${ZSH_VERSION+set} = xset ; then- $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should"- $as_echo "$0: be upgraded to zsh 4.3.4 or later."- else- $as_echo "$0: Please tell bug-autoconf@gnu.org and-$0: accelerate-haskell@googlegroups.com about your system,-$0: including any error possibly output before this-$0: message. Then install a modern shell, or manually run-$0: the script under such a shell if you do have one."- fi- exit 1-fi-fi-fi-SHELL=${CONFIG_SHELL-/bin/sh}-export SHELL-# Unset more variables known to interfere with behavior of common tools.-CLICOLOR_FORCE= GREP_OPTIONS=-unset CLICOLOR_FORCE GREP_OPTIONS--## --------------------- ##-## M4sh Shell Functions. ##-## --------------------- ##-# as_fn_unset VAR-# ----------------# Portably unset VAR.-as_fn_unset ()-{- { eval $1=; unset $1;}-}-as_unset=as_fn_unset--# as_fn_set_status STATUS-# ------------------------# Set $? to STATUS, without forking.-as_fn_set_status ()-{- return $1-} # as_fn_set_status--# as_fn_exit STATUS-# ------------------# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.-as_fn_exit ()-{- set +e- as_fn_set_status $1- exit $1-} # as_fn_exit--# as_fn_mkdir_p-# --------------# Create "$as_dir" as a directory, including parents if necessary.-as_fn_mkdir_p ()-{-- case $as_dir in #(- -*) as_dir=./$as_dir;;- esac- test -d "$as_dir" || eval $as_mkdir_p || {- as_dirs=- while :; do- case $as_dir in #(- *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(- *) as_qdir=$as_dir;;- esac- as_dirs="'$as_qdir' $as_dirs"- as_dir=`$as_dirname -- "$as_dir" ||-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \- X"$as_dir" : 'X\(//\)[^/]' \| \- X"$as_dir" : 'X\(//\)$' \| \- X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_dir" |- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{- s//\1/- q- }- /^X\(\/\/\)[^/].*/{- s//\1/- q- }- /^X\(\/\/\)$/{- s//\1/- q- }- /^X\(\/\).*/{- s//\1/- q- }- s/.*/./; q'`- test -d "$as_dir" && break- done- test -z "$as_dirs" || eval "mkdir $as_dirs"- } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"---} # as_fn_mkdir_p--# as_fn_executable_p FILE-# ------------------------# Test if FILE is an executable regular file.-as_fn_executable_p ()-{- test -f "$1" && test -x "$1"-} # as_fn_executable_p-# as_fn_append VAR VALUE-# -----------------------# Append the text in VALUE to the end of the definition contained in VAR. Take-# advantage of any shell optimizations that allow amortized linear growth over-# repeated appends, instead of the typical quadratic growth present in naive-# implementations.-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :- eval 'as_fn_append ()- {- eval $1+=\$2- }'-else- as_fn_append ()- {- eval $1=\$$1\$2- }-fi # as_fn_append--# as_fn_arith ARG...-# -------------------# Perform arithmetic evaluation on the ARGs, and store the result in the-# global $as_val. Take advantage of shells that can avoid forks. The arguments-# must be portable across $(()) and expr.-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :- eval 'as_fn_arith ()- {- as_val=$(( $* ))- }'-else- as_fn_arith ()- {- as_val=`expr "$@" || test $? -eq 1`- }-fi # as_fn_arith---# as_fn_error STATUS ERROR [LINENO LOG_FD]-# -----------------------------------------# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the-# script with STATUS, using 1 if that was 0.-as_fn_error ()-{- as_status=$1; test $as_status -eq 0 && as_status=1- if test "$4"; then- as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4- fi- $as_echo "$as_me: error: $2" >&2- as_fn_exit $as_status-} # as_fn_error--if expr a : '\(a\)' >/dev/null 2>&1 &&- test "X`expr 00001 : '.*\(...\)'`" = X001; then- as_expr=expr-else- as_expr=false-fi--if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then- as_basename=basename-else- as_basename=false-fi--if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then- as_dirname=dirname-else- as_dirname=false-fi--as_me=`$as_basename -- "$0" ||-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \- X"$0" : 'X\(//\)$' \| \- X"$0" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X/"$0" |- sed '/^.*\/\([^/][^/]*\)\/*$/{- s//\1/- q- }- /^X\/\(\/\/\)$/{- s//\1/- q- }- /^X\/\(\/\).*/{- s//\1/- q- }- s/.*/./; q'`--# Avoid depending upon Character Ranges.-as_cr_letters='abcdefghijklmnopqrstuvwxyz'-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'-as_cr_Letters=$as_cr_letters$as_cr_LETTERS-as_cr_digits='0123456789'-as_cr_alnum=$as_cr_Letters$as_cr_digits--- as_lineno_1=$LINENO as_lineno_1a=$LINENO- as_lineno_2=$LINENO as_lineno_2a=$LINENO- eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" &&- test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || {- # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-)- sed -n '- p- /[$]LINENO/=- ' <$as_myself |- sed '- s/[$]LINENO.*/&-/- t lineno- b- :lineno- N- :loop- s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/- t loop- s/-\n.*//- ' >$as_me.lineno &&- chmod +x "$as_me.lineno" ||- { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }-- # If we had to re-execute with $CONFIG_SHELL, we're ensured to have- # already done that, so ensure we don't try to do so again and fall- # in an infinite loop. This has already happened in practice.- _as_can_reexec=no; export _as_can_reexec- # Don't try to exec as it changes $[0], causing all sort of problems- # (the dirname of $[0] is not the place where we might find the- # original and so on. Autoconf is especially sensitive to this).- . "./$as_me.lineno"- # Exit status is that of the last command.- exit-}--ECHO_C= ECHO_N= ECHO_T=-case `echo -n x` in #(((((--n*)- case `echo 'xy\c'` in- *c*) ECHO_T=' ';; # ECHO_T is single tab character.- xy) ECHO_C='\c';;- *) echo `echo ksh88 bug on AIX 6.1` > /dev/null- ECHO_T=' ';;- esac;;-*)- ECHO_N='-n';;-esac--rm -f conf$$ conf$$.exe conf$$.file-if test -d conf$$.dir; then- rm -f conf$$.dir/conf$$.file-else- rm -f conf$$.dir- mkdir conf$$.dir 2>/dev/null-fi-if (echo >conf$$.file) 2>/dev/null; then- if ln -s conf$$.file conf$$ 2>/dev/null; then- as_ln_s='ln -s'- # ... but there are two gotchas:- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.- # In both cases, we have to default to `cp -pR'.- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||- as_ln_s='cp -pR'- elif ln conf$$.file conf$$ 2>/dev/null; then- as_ln_s=ln- else- as_ln_s='cp -pR'- fi-else- as_ln_s='cp -pR'-fi-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file-rmdir conf$$.dir 2>/dev/null--if mkdir -p . 2>/dev/null; then- as_mkdir_p='mkdir -p "$as_dir"'-else- test -d ./-p && rmdir ./-p- as_mkdir_p=false-fi--as_test_x='test -x'-as_executable_p=as_fn_executable_p--# Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"--# Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"---test -n "$DJDIR" || exec 7<&0 </dev/null-exec 6>&1--# Name of the host.-# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status,-# so uname gets run too.-ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q`--#-# Initializations.-#-ac_default_prefix=/usr/local-ac_clean_files=-ac_config_libobj_dir=.-LIBOBJS=-cross_compiling=no-subdirs=-MFLAGS=-MAKEFLAGS=--# Identity of this package.-PACKAGE_NAME='accelerate'-PACKAGE_TARNAME='accelerate'-PACKAGE_VERSION='0.14.0.0'-PACKAGE_STRING='accelerate 0.14.0.0'-PACKAGE_BUGREPORT='accelerate-haskell@googlegroups.com'-PACKAGE_URL=''--ac_unique_file="Data/Array/Accelerate.hs"-ac_subst_vars='LTLIBOBJS-LIBOBJS-cpp_flags-ghc_flags-GHC-target_alias-host_alias-build_alias-LIBS-ECHO_T-ECHO_N-ECHO_C-DEFS-mandir-localedir-libdir-psdir-pdfdir-dvidir-htmldir-infodir-docdir-oldincludedir-includedir-localstatedir-sharedstatedir-sysconfdir-datadir-datarootdir-libexecdir-sbindir-bindir-program_transform_name-prefix-exec_prefix-PACKAGE_URL-PACKAGE_BUGREPORT-PACKAGE_STRING-PACKAGE_VERSION-PACKAGE_TARNAME-PACKAGE_NAME-PATH_SEPARATOR-SHELL'-ac_subst_files=''-ac_user_opts='-enable_option_checking-with_compiler-with_gcc-'- ac_precious_vars='build_alias-host_alias-target_alias'---# Initialize some variables set by options.-ac_init_help=-ac_init_version=false-ac_unrecognized_opts=-ac_unrecognized_sep=-# The variables have the same names as the options, with-# dashes changed to underlines.-cache_file=/dev/null-exec_prefix=NONE-no_create=-no_recursion=-prefix=NONE-program_prefix=NONE-program_suffix=NONE-program_transform_name=s,x,x,-silent=-site=-srcdir=-verbose=-x_includes=NONE-x_libraries=NONE--# Installation directory options.-# These are left unexpanded so users can "make install exec_prefix=/foo"-# and all the variables that are supposed to be based on exec_prefix-# by default will actually change.-# Use braces instead of parens because sh, perl, etc. also accept them.-# (The list follows the same order as the GNU Coding Standards.)-bindir='${exec_prefix}/bin'-sbindir='${exec_prefix}/sbin'-libexecdir='${exec_prefix}/libexec'-datarootdir='${prefix}/share'-datadir='${datarootdir}'-sysconfdir='${prefix}/etc'-sharedstatedir='${prefix}/com'-localstatedir='${prefix}/var'-includedir='${prefix}/include'-oldincludedir='/usr/include'-docdir='${datarootdir}/doc/${PACKAGE_TARNAME}'-infodir='${datarootdir}/info'-htmldir='${docdir}'-dvidir='${docdir}'-pdfdir='${docdir}'-psdir='${docdir}'-libdir='${exec_prefix}/lib'-localedir='${datarootdir}/locale'-mandir='${datarootdir}/man'--ac_prev=-ac_dashdash=-for ac_option-do- # If the previous option needs an argument, assign it.- if test -n "$ac_prev"; then- eval $ac_prev=\$ac_option- ac_prev=- continue- fi-- case $ac_option in- *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;;- *=) ac_optarg= ;;- *) ac_optarg=yes ;;- esac-- # Accept the important Cygnus configure options, so we can diagnose typos.-- case $ac_dashdash$ac_option in- --)- ac_dashdash=yes ;;-- -bindir | --bindir | --bindi | --bind | --bin | --bi)- ac_prev=bindir ;;- -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)- bindir=$ac_optarg ;;-- -build | --build | --buil | --bui | --bu)- ac_prev=build_alias ;;- -build=* | --build=* | --buil=* | --bui=* | --bu=*)- build_alias=$ac_optarg ;;-- -cache-file | --cache-file | --cache-fil | --cache-fi \- | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)- ac_prev=cache_file ;;- -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \- | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)- cache_file=$ac_optarg ;;-- --config-cache | -C)- cache_file=config.cache ;;-- -datadir | --datadir | --datadi | --datad)- ac_prev=datadir ;;- -datadir=* | --datadir=* | --datadi=* | --datad=*)- datadir=$ac_optarg ;;-- -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \- | --dataroo | --dataro | --datar)- ac_prev=datarootdir ;;- -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \- | --dataroot=* | --dataroo=* | --dataro=* | --datar=*)- datarootdir=$ac_optarg ;;-- -disable-* | --disable-*)- ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'`- # Reject names that are not valid shell variable names.- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error $? "invalid feature name: $ac_useropt"- ac_useropt_orig=$ac_useropt- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`- case $ac_user_opts in- *"-"enable_$ac_useropt"-"*) ;;- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig"- ac_unrecognized_sep=', ';;- esac- eval enable_$ac_useropt=no ;;-- -docdir | --docdir | --docdi | --doc | --do)- ac_prev=docdir ;;- -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*)- docdir=$ac_optarg ;;-- -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv)- ac_prev=dvidir ;;- -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*)- dvidir=$ac_optarg ;;-- -enable-* | --enable-*)- ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'`- # Reject names that are not valid shell variable names.- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error $? "invalid feature name: $ac_useropt"- ac_useropt_orig=$ac_useropt- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`- case $ac_user_opts in- *"-"enable_$ac_useropt"-"*) ;;- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig"- ac_unrecognized_sep=', ';;- esac- eval enable_$ac_useropt=\$ac_optarg ;;-- -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \- | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \- | --exec | --exe | --ex)- ac_prev=exec_prefix ;;- -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \- | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \- | --exec=* | --exe=* | --ex=*)- exec_prefix=$ac_optarg ;;-- -gas | --gas | --ga | --g)- # Obsolete; use --with-gas.- with_gas=yes ;;-- -help | --help | --hel | --he | -h)- ac_init_help=long ;;- -help=r* | --help=r* | --hel=r* | --he=r* | -hr*)- ac_init_help=recursive ;;- -help=s* | --help=s* | --hel=s* | --he=s* | -hs*)- ac_init_help=short ;;-- -host | --host | --hos | --ho)- ac_prev=host_alias ;;- -host=* | --host=* | --hos=* | --ho=*)- host_alias=$ac_optarg ;;-- -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht)- ac_prev=htmldir ;;- -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \- | --ht=*)- htmldir=$ac_optarg ;;-- -includedir | --includedir | --includedi | --included | --include \- | --includ | --inclu | --incl | --inc)- ac_prev=includedir ;;- -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \- | --includ=* | --inclu=* | --incl=* | --inc=*)- includedir=$ac_optarg ;;-- -infodir | --infodir | --infodi | --infod | --info | --inf)- ac_prev=infodir ;;- -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)- infodir=$ac_optarg ;;-- -libdir | --libdir | --libdi | --libd)- ac_prev=libdir ;;- -libdir=* | --libdir=* | --libdi=* | --libd=*)- libdir=$ac_optarg ;;-- -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \- | --libexe | --libex | --libe)- ac_prev=libexecdir ;;- -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \- | --libexe=* | --libex=* | --libe=*)- libexecdir=$ac_optarg ;;-- -localedir | --localedir | --localedi | --localed | --locale)- ac_prev=localedir ;;- -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*)- localedir=$ac_optarg ;;-- -localstatedir | --localstatedir | --localstatedi | --localstated \- | --localstate | --localstat | --localsta | --localst | --locals)- ac_prev=localstatedir ;;- -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \- | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*)- localstatedir=$ac_optarg ;;-- -mandir | --mandir | --mandi | --mand | --man | --ma | --m)- ac_prev=mandir ;;- -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)- mandir=$ac_optarg ;;-- -nfp | --nfp | --nf)- # Obsolete; use --without-fp.- with_fp=no ;;-- -no-create | --no-create | --no-creat | --no-crea | --no-cre \- | --no-cr | --no-c | -n)- no_create=yes ;;-- -no-recursion | --no-recursion | --no-recursio | --no-recursi \- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)- no_recursion=yes ;;-- -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \- | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \- | --oldin | --oldi | --old | --ol | --o)- ac_prev=oldincludedir ;;- -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \- | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \- | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)- oldincludedir=$ac_optarg ;;-- -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)- ac_prev=prefix ;;- -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)- prefix=$ac_optarg ;;-- -program-prefix | --program-prefix | --program-prefi | --program-pref \- | --program-pre | --program-pr | --program-p)- ac_prev=program_prefix ;;- -program-prefix=* | --program-prefix=* | --program-prefi=* \- | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)- program_prefix=$ac_optarg ;;-- -program-suffix | --program-suffix | --program-suffi | --program-suff \- | --program-suf | --program-su | --program-s)- ac_prev=program_suffix ;;- -program-suffix=* | --program-suffix=* | --program-suffi=* \- | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)- program_suffix=$ac_optarg ;;-- -program-transform-name | --program-transform-name \- | --program-transform-nam | --program-transform-na \- | --program-transform-n | --program-transform- \- | --program-transform | --program-transfor \- | --program-transfo | --program-transf \- | --program-trans | --program-tran \- | --progr-tra | --program-tr | --program-t)- ac_prev=program_transform_name ;;- -program-transform-name=* | --program-transform-name=* \- | --program-transform-nam=* | --program-transform-na=* \- | --program-transform-n=* | --program-transform-=* \- | --program-transform=* | --program-transfor=* \- | --program-transfo=* | --program-transf=* \- | --program-trans=* | --program-tran=* \- | --progr-tra=* | --program-tr=* | --program-t=*)- program_transform_name=$ac_optarg ;;-- -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd)- ac_prev=pdfdir ;;- -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*)- pdfdir=$ac_optarg ;;-- -psdir | --psdir | --psdi | --psd | --ps)- ac_prev=psdir ;;- -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*)- psdir=$ac_optarg ;;-- -q | -quiet | --quiet | --quie | --qui | --qu | --q \- | -silent | --silent | --silen | --sile | --sil)- silent=yes ;;-- -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)- ac_prev=sbindir ;;- -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \- | --sbi=* | --sb=*)- sbindir=$ac_optarg ;;-- -sharedstatedir | --sharedstatedir | --sharedstatedi \- | --sharedstated | --sharedstate | --sharedstat | --sharedsta \- | --sharedst | --shareds | --shared | --share | --shar \- | --sha | --sh)- ac_prev=sharedstatedir ;;- -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \- | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \- | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \- | --sha=* | --sh=*)- sharedstatedir=$ac_optarg ;;-- -site | --site | --sit)- ac_prev=site ;;- -site=* | --site=* | --sit=*)- site=$ac_optarg ;;-- -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)- ac_prev=srcdir ;;- -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)- srcdir=$ac_optarg ;;-- -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \- | --syscon | --sysco | --sysc | --sys | --sy)- ac_prev=sysconfdir ;;- -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \- | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)- sysconfdir=$ac_optarg ;;-- -target | --target | --targe | --targ | --tar | --ta | --t)- ac_prev=target_alias ;;- -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)- target_alias=$ac_optarg ;;-- -v | -verbose | --verbose | --verbos | --verbo | --verb)- verbose=yes ;;-- -version | --version | --versio | --versi | --vers | -V)- ac_init_version=: ;;-- -with-* | --with-*)- ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'`- # Reject names that are not valid shell variable names.- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error $? "invalid package name: $ac_useropt"- ac_useropt_orig=$ac_useropt- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`- case $ac_user_opts in- *"-"with_$ac_useropt"-"*) ;;- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig"- ac_unrecognized_sep=', ';;- esac- eval with_$ac_useropt=\$ac_optarg ;;-- -without-* | --without-*)- ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'`- # Reject names that are not valid shell variable names.- expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null &&- as_fn_error $? "invalid package name: $ac_useropt"- ac_useropt_orig=$ac_useropt- ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'`- case $ac_user_opts in- *"-"with_$ac_useropt"-"*) ;;- *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig"- ac_unrecognized_sep=', ';;- esac- eval with_$ac_useropt=no ;;-- --x)- # Obsolete; use --with-x.- with_x=yes ;;-- -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \- | --x-incl | --x-inc | --x-in | --x-i)- ac_prev=x_includes ;;- -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \- | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)- x_includes=$ac_optarg ;;-- -x-libraries | --x-libraries | --x-librarie | --x-librari \- | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)- ac_prev=x_libraries ;;- -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \- | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)- x_libraries=$ac_optarg ;;-- -*) as_fn_error $? "unrecognized option: \`$ac_option'-Try \`$0 --help' for more information"- ;;-- *=*)- ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='`- # Reject names that are not valid shell variable names.- case $ac_envvar in #(- '' | [0-9]* | *[!_$as_cr_alnum]* )- as_fn_error $? "invalid variable name: \`$ac_envvar'" ;;- esac- eval $ac_envvar=\$ac_optarg- export $ac_envvar ;;-- *)- # FIXME: should be removed in autoconf 3.0.- $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2- expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null &&- $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2- : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}"- ;;-- esac-done--if test -n "$ac_prev"; then- ac_option=--`echo $ac_prev | sed 's/_/-/g'`- as_fn_error $? "missing argument to $ac_option"-fi--if test -n "$ac_unrecognized_opts"; then- case $enable_option_checking in- no) ;;- fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;;- *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;;- esac-fi--# Check all directory arguments for consistency.-for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \- datadir sysconfdir sharedstatedir localstatedir includedir \- oldincludedir docdir infodir htmldir dvidir pdfdir psdir \- libdir localedir mandir-do- eval ac_val=\$$ac_var- # Remove trailing slashes.- case $ac_val in- */ )- ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'`- eval $ac_var=\$ac_val;;- esac- # Be sure to have absolute directory names.- case $ac_val in- [\\/$]* | ?:[\\/]* ) continue;;- NONE | '' ) case $ac_var in *prefix ) continue;; esac;;- esac- as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val"-done--# There might be people who depend on the old broken behavior: `$host'-# used to hold the argument of --host etc.-# FIXME: To remove some day.-build=$build_alias-host=$host_alias-target=$target_alias--# FIXME: To remove some day.-if test "x$host_alias" != x; then- if test "x$build_alias" = x; then- cross_compiling=maybe- elif test "x$build_alias" != "x$host_alias"; then- cross_compiling=yes- fi-fi--ac_tool_prefix=-test -n "$host_alias" && ac_tool_prefix=$host_alias---test "$silent" = yes && exec 6>/dev/null---ac_pwd=`pwd` && test -n "$ac_pwd" &&-ac_ls_di=`ls -di .` &&-ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` ||- as_fn_error $? "working directory cannot be determined"-test "X$ac_ls_di" = "X$ac_pwd_ls_di" ||- as_fn_error $? "pwd does not report name of working directory"---# Find the source files, if location was not specified.-if test -z "$srcdir"; then- ac_srcdir_defaulted=yes- # Try the directory containing this script, then the parent directory.- ac_confdir=`$as_dirname -- "$as_myself" ||-$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \- X"$as_myself" : 'X\(//\)[^/]' \| \- X"$as_myself" : 'X\(//\)$' \| \- X"$as_myself" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_myself" |- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{- s//\1/- q- }- /^X\(\/\/\)[^/].*/{- s//\1/- q- }- /^X\(\/\/\)$/{- s//\1/- q- }- /^X\(\/\).*/{- s//\1/- q- }- s/.*/./; q'`- srcdir=$ac_confdir- if test ! -r "$srcdir/$ac_unique_file"; then- srcdir=..- fi-else- ac_srcdir_defaulted=no-fi-if test ! -r "$srcdir/$ac_unique_file"; then- test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .."- as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir"-fi-ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work"-ac_abs_confdir=`(- cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg"- pwd)`-# When building in place, set srcdir=.-if test "$ac_abs_confdir" = "$ac_pwd"; then- srcdir=.-fi-# Remove unnecessary trailing slashes from srcdir.-# Double slashes in file names in object file debugging info-# mess up M-x gdb in Emacs.-case $srcdir in-*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;;-esac-for ac_var in $ac_precious_vars; do- eval ac_env_${ac_var}_set=\${${ac_var}+set}- eval ac_env_${ac_var}_value=\$${ac_var}- eval ac_cv_env_${ac_var}_set=\${${ac_var}+set}- eval ac_cv_env_${ac_var}_value=\$${ac_var}-done--#-# Report the --help message.-#-if test "$ac_init_help" = "long"; then- # Omit some internal or obsolete options to make the list less imposing.- # This message is too long to be a string in the A/UX 3.1 sh.- cat <<_ACEOF-\`configure' configures accelerate 0.14.0.0 to adapt to many kinds of systems.--Usage: $0 [OPTION]... [VAR=VALUE]...--To assign environment variables (e.g., CC, CFLAGS...), specify them as-VAR=VALUE. See below for descriptions of some of the useful variables.--Defaults for the options are specified in brackets.--Configuration:- -h, --help display this help and exit- --help=short display options specific to this package- --help=recursive display the short help of all the included packages- -V, --version display version information and exit- -q, --quiet, --silent do not print \`checking ...' messages- --cache-file=FILE cache test results in FILE [disabled]- -C, --config-cache alias for \`--cache-file=config.cache'- -n, --no-create do not create output files- --srcdir=DIR find the sources in DIR [configure dir or \`..']--Installation directories:- --prefix=PREFIX install architecture-independent files in PREFIX- [$ac_default_prefix]- --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX- [PREFIX]--By default, \`make install' will install all the files in-\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify-an installation prefix other than \`$ac_default_prefix' using \`--prefix',-for instance \`--prefix=\$HOME'.--For better control, use the options below.--Fine tuning of the installation directories:- --bindir=DIR user executables [EPREFIX/bin]- --sbindir=DIR system admin executables [EPREFIX/sbin]- --libexecdir=DIR program executables [EPREFIX/libexec]- --sysconfdir=DIR read-only single-machine data [PREFIX/etc]- --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com]- --localstatedir=DIR modifiable single-machine data [PREFIX/var]- --libdir=DIR object code libraries [EPREFIX/lib]- --includedir=DIR C header files [PREFIX/include]- --oldincludedir=DIR C header files for non-gcc [/usr/include]- --datarootdir=DIR read-only arch.-independent data root [PREFIX/share]- --datadir=DIR read-only architecture-independent data [DATAROOTDIR]- --infodir=DIR info documentation [DATAROOTDIR/info]- --localedir=DIR locale-dependent data [DATAROOTDIR/locale]- --mandir=DIR man documentation [DATAROOTDIR/man]- --docdir=DIR documentation root [DATAROOTDIR/doc/accelerate]- --htmldir=DIR html documentation [DOCDIR]- --dvidir=DIR dvi documentation [DOCDIR]- --pdfdir=DIR pdf documentation [DOCDIR]- --psdir=DIR ps documentation [DOCDIR]-_ACEOF-- cat <<\_ACEOF-_ACEOF-fi--if test -n "$ac_init_help"; then- case $ac_init_help in- short | recursive ) echo "Configuration of accelerate 0.14.0.0:";;- esac- cat <<\_ACEOF--Optional Packages:- --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]- --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)-Haskell compiler-C compiler--Report bugs to <accelerate-haskell@googlegroups.com>.-_ACEOF-ac_status=$?-fi--if test "$ac_init_help" = "recursive"; then- # If there are subdirs, report their specific --help.- for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue- test -d "$ac_dir" ||- { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } ||- continue- ac_builddir=.--case "$ac_dir" in-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;-*)- ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`- # A ".." for each directory in $ac_dir_suffix.- ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`- case $ac_top_builddir_sub in- "") ac_top_builddir_sub=. ac_top_build_prefix= ;;- *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;- esac ;;-esac-ac_abs_top_builddir=$ac_pwd-ac_abs_builddir=$ac_pwd$ac_dir_suffix-# for backward compatibility:-ac_top_builddir=$ac_top_build_prefix--case $srcdir in- .) # We are building in place.- ac_srcdir=.- ac_top_srcdir=$ac_top_builddir_sub- ac_abs_top_srcdir=$ac_pwd ;;- [\\/]* | ?:[\\/]* ) # Absolute name.- ac_srcdir=$srcdir$ac_dir_suffix;- ac_top_srcdir=$srcdir- ac_abs_top_srcdir=$srcdir ;;- *) # Relative name.- ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix- ac_top_srcdir=$ac_top_build_prefix$srcdir- ac_abs_top_srcdir=$ac_pwd/$srcdir ;;-esac-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix-- cd "$ac_dir" || { ac_status=$?; continue; }- # Check for guested configure.- if test -f "$ac_srcdir/configure.gnu"; then- echo &&- $SHELL "$ac_srcdir/configure.gnu" --help=recursive- elif test -f "$ac_srcdir/configure"; then- echo &&- $SHELL "$ac_srcdir/configure" --help=recursive- else- $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2- fi || ac_status=$?- cd "$ac_pwd" || { ac_status=$?; break; }- done-fi--test -n "$ac_init_help" && exit $ac_status-if $ac_init_version; then- cat <<\_ACEOF-accelerate configure 0.14.0.0-generated by GNU Autoconf 2.69--Copyright (C) 2012 Free Software Foundation, Inc.-This configure script is free software; the Free Software Foundation-gives unlimited permission to copy, distribute and modify it.-_ACEOF- exit-fi--## ------------------------ ##-## Autoconf initialization. ##-## ------------------------ ##-cat >config.log <<_ACEOF-This file contains any messages produced by compilers while-running configure, to aid debugging if configure makes a mistake.--It was created by accelerate $as_me 0.14.0.0, which was-generated by GNU Autoconf 2.69. Invocation command line was-- $ $0 $@--_ACEOF-exec 5>>config.log-{-cat <<_ASUNAME-## --------- ##-## Platform. ##-## --------- ##--hostname = `(hostname || uname -n) 2>/dev/null | sed 1q`-uname -m = `(uname -m) 2>/dev/null || echo unknown`-uname -r = `(uname -r) 2>/dev/null || echo unknown`-uname -s = `(uname -s) 2>/dev/null || echo unknown`-uname -v = `(uname -v) 2>/dev/null || echo unknown`--/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown`-/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown`--/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown`-/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown`-/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown`-/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown`-/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown`-/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown`-/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown`--_ASUNAME--as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do- IFS=$as_save_IFS- test -z "$as_dir" && as_dir=.- $as_echo "PATH: $as_dir"- done-IFS=$as_save_IFS--} >&5--cat >&5 <<_ACEOF---## ----------- ##-## Core tests. ##-## ----------- ##--_ACEOF---# Keep a trace of the command line.-# Strip out --no-create and --no-recursion so they do not pile up.-# Strip out --silent because we don't want to record it for future runs.-# Also quote any args containing shell meta-characters.-# Make two passes to allow for proper duplicate-argument suppression.-ac_configure_args=-ac_configure_args0=-ac_configure_args1=-ac_must_keep_next=false-for ac_pass in 1 2-do- for ac_arg- do- case $ac_arg in- -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;;- -q | -quiet | --quiet | --quie | --qui | --qu | --q \- | -silent | --silent | --silen | --sile | --sil)- continue ;;- *\'*)- ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;;- esac- case $ac_pass in- 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;;- 2)- as_fn_append ac_configure_args1 " '$ac_arg'"- if test $ac_must_keep_next = true; then- ac_must_keep_next=false # Got value, back to normal.- else- case $ac_arg in- *=* | --config-cache | -C | -disable-* | --disable-* \- | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \- | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \- | -with-* | --with-* | -without-* | --without-* | --x)- case "$ac_configure_args0 " in- "$ac_configure_args1"*" '$ac_arg' "* ) continue ;;- esac- ;;- -* ) ac_must_keep_next=true ;;- esac- fi- as_fn_append ac_configure_args " '$ac_arg'"- ;;- esac- done-done-{ ac_configure_args0=; unset ac_configure_args0;}-{ ac_configure_args1=; unset ac_configure_args1;}--# When interrupted or exit'd, cleanup temporary files, and complete-# config.log. We remove comments because anyway the quotes in there-# would cause problems or look ugly.-# WARNING: Use '\'' to represent an apostrophe within the trap.-# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug.-trap 'exit_status=$?- # Save into config.log some information that might help in debugging.- {- echo-- $as_echo "## ---------------- ##-## Cache variables. ##-## ---------------- ##"- echo- # The following way of writing the cache mishandles newlines in values,-(- for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do- eval ac_val=\$$ac_var- case $ac_val in #(- *${as_nl}*)- case $ac_var in #(- *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;- esac- case $ac_var in #(- _ | IFS | as_nl) ;; #(- BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(- *) { eval $ac_var=; unset $ac_var;} ;;- esac ;;- esac- done- (set) 2>&1 |- case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #(- *${as_nl}ac_space=\ *)- sed -n \- "s/'\''/'\''\\\\'\'''\''/g;- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p"- ;; #(- *)- sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"- ;;- esac |- sort-)- echo-- $as_echo "## ----------------- ##-## Output variables. ##-## ----------------- ##"- echo- for ac_var in $ac_subst_vars- do- eval ac_val=\$$ac_var- case $ac_val in- *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;- esac- $as_echo "$ac_var='\''$ac_val'\''"- done | sort- echo-- if test -n "$ac_subst_files"; then- $as_echo "## ------------------- ##-## File substitutions. ##-## ------------------- ##"- echo- for ac_var in $ac_subst_files- do- eval ac_val=\$$ac_var- case $ac_val in- *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;;- esac- $as_echo "$ac_var='\''$ac_val'\''"- done | sort- echo- fi-- if test -s confdefs.h; then- $as_echo "## ----------- ##-## confdefs.h. ##-## ----------- ##"- echo- cat confdefs.h- echo- fi- test "$ac_signal" != 0 &&- $as_echo "$as_me: caught signal $ac_signal"- $as_echo "$as_me: exit $exit_status"- } >&5- rm -f core *.core core.conftest.* &&- rm -f -r conftest* confdefs* conf$$* $ac_clean_files &&- exit $exit_status-' 0-for ac_signal in 1 2 13 15; do- trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal-done-ac_signal=0--# confdefs.h avoids OS command line length limits that DEFS can exceed.-rm -f -r conftest* confdefs.h--$as_echo "/* confdefs.h */" > confdefs.h--# Predefined preprocessor variables.--cat >>confdefs.h <<_ACEOF-#define PACKAGE_NAME "$PACKAGE_NAME"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_TARNAME "$PACKAGE_TARNAME"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_VERSION "$PACKAGE_VERSION"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_STRING "$PACKAGE_STRING"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT"-_ACEOF--cat >>confdefs.h <<_ACEOF-#define PACKAGE_URL "$PACKAGE_URL"-_ACEOF---# Let the site file select an alternate cache file if it wants to.-# Prefer an explicitly selected file to automatically selected ones.-ac_site_file1=NONE-ac_site_file2=NONE-if test -n "$CONFIG_SITE"; then- # We do not want a PATH search for config.site.- case $CONFIG_SITE in #((- -*) ac_site_file1=./$CONFIG_SITE;;- */*) ac_site_file1=$CONFIG_SITE;;- *) ac_site_file1=./$CONFIG_SITE;;- esac-elif test "x$prefix" != xNONE; then- ac_site_file1=$prefix/share/config.site- ac_site_file2=$prefix/etc/config.site-else- ac_site_file1=$ac_default_prefix/share/config.site- ac_site_file2=$ac_default_prefix/etc/config.site-fi-for ac_site_file in "$ac_site_file1" "$ac_site_file2"-do- test "x$ac_site_file" = xNONE && continue- if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then- { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5-$as_echo "$as_me: loading site script $ac_site_file" >&6;}- sed 's/^/| /' "$ac_site_file" >&5- . "$ac_site_file" \- || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}-as_fn_error $? "failed to load site script $ac_site_file-See \`config.log' for more details" "$LINENO" 5; }- fi-done--if test -r "$cache_file"; then- # Some versions of bash will fail to source /dev/null (special files- # actually), so we avoid doing that. DJGPP emulates it as a regular file.- if test /dev/null != "$cache_file" && test -f "$cache_file"; then- { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5-$as_echo "$as_me: loading cache $cache_file" >&6;}- case $cache_file in- [\\/]* | ?:[\\/]* ) . "$cache_file";;- *) . "./$cache_file";;- esac- fi-else- { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5-$as_echo "$as_me: creating cache $cache_file" >&6;}- >$cache_file-fi--# Check that the precious variables saved in the cache have kept the same-# value.-ac_cache_corrupted=false-for ac_var in $ac_precious_vars; do- eval ac_old_set=\$ac_cv_env_${ac_var}_set- eval ac_new_set=\$ac_env_${ac_var}_set- eval ac_old_val=\$ac_cv_env_${ac_var}_value- eval ac_new_val=\$ac_env_${ac_var}_value- case $ac_old_set,$ac_new_set in- set,)- { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5-$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;}- ac_cache_corrupted=: ;;- ,set)- { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5-$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;}- ac_cache_corrupted=: ;;- ,);;- *)- if test "x$ac_old_val" != "x$ac_new_val"; then- # differences in whitespace do not lead to failure.- ac_old_val_w=`echo x $ac_old_val`- ac_new_val_w=`echo x $ac_new_val`- if test "$ac_old_val_w" != "$ac_new_val_w"; then- { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5-$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;}- ac_cache_corrupted=:- else- { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5-$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;}- eval $ac_var=\$ac_old_val- fi- { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5-$as_echo "$as_me: former value: \`$ac_old_val'" >&2;}- { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5-$as_echo "$as_me: current value: \`$ac_new_val'" >&2;}- fi;;- esac- # Pass precious variables to config.status.- if test "$ac_new_set" = set; then- case $ac_new_val in- *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;;- *) ac_arg=$ac_var=$ac_new_val ;;- esac- case " $ac_configure_args " in- *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy.- *) as_fn_append ac_configure_args " '$ac_arg'" ;;- esac- fi-done-if $ac_cache_corrupted; then- { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5-$as_echo "$as_me: error: in \`$ac_pwd':" >&2;}- { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5-$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;}- as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5-fi-## -------------------- ##-## Main body of script. ##-## -------------------- ##--ac_ext=c-ac_cpp='$CPP $CPPFLAGS'-ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5'-ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5'-ac_compiler_gnu=$ac_cv_c_compiler_gnu----ac_config_files="$ac_config_files accelerate.buildinfo"----# Check whether --with-compiler was given.-if test "${with_compiler+set}" = set; then :- withval=$with_compiler; GHC=$withval-else- # Extract the first word of "ghc", so it can be a program name with args.-set dummy ghc; ac_word=$2-{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5-$as_echo_n "checking for $ac_word... " >&6; }-if ${ac_cv_path_GHC+:} false; then :- $as_echo_n "(cached) " >&6-else- case $GHC in- [\\/]* | ?:[\\/]*)- ac_cv_path_GHC="$GHC" # Let the user override the test with a path.- ;;- *)- as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do- IFS=$as_save_IFS- test -z "$as_dir" && as_dir=.- for ac_exec_ext in '' $ac_executable_extensions; do- if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then- ac_cv_path_GHC="$as_dir/$ac_word$ac_exec_ext"- $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5- break 2- fi-done- done-IFS=$as_save_IFS-- ;;-esac-fi-GHC=$ac_cv_path_GHC-if test -n "$GHC"; then- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $GHC" >&5-$as_echo "$GHC" >&6; }-else- { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5-$as_echo "no" >&6; }-fi---fi---# Check whether --with-gcc was given.-if test "${with_gcc+set}" = set; then :- withval=$with_gcc; CC=$withval-fi------ { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of CLong" >&5-$as_echo_n "checking size of CLong... " >&6; }-- sizeof_hs_CLong=`$GHC -w -ignore-dot-ghci -e "import Foreign" -e "import Foreign.C" -e "putStr . show $ sizeOf (undefined::CLong)"`- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_hs_CLong" >&5-$as_echo "$sizeof_hs_CLong" >&6; }-- case $sizeof_hs_CLong in- 4) type_hs_long=Int32 ;;- 8) type_hs_long=Int64 ;;- esac-- # The type name- def="-DHTYPE_LONG=$type_hs_long"- cpp_flags="$cpp_flags $def"- ghc_flags="$ghc_flags -optP$def"-- # And size- def="-DSIZEOF_HTYPE_LONG=$sizeof_hs_CLong"- cpp_flags="$cpp_flags $def"- ghc_flags="$ghc_flags -optP$def"--- { $as_echo "$as_me:${as_lineno-$LINENO}: checking size of CULong" >&5-$as_echo_n "checking size of CULong... " >&6; }-- sizeof_hs_CULong=`$GHC -w -ignore-dot-ghci -e "import Foreign" -e "import Foreign.C" -e "putStr . show $ sizeOf (undefined::CULong)"`- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $sizeof_hs_CULong" >&5-$as_echo "$sizeof_hs_CULong" >&6; }-- case $sizeof_hs_CULong in- 4) type_hs_unsigned_long=Word32 ;;- 8) type_hs_unsigned_long=Word64 ;;- esac-- # The type name- def="-DHTYPE_UNSIGNED_LONG=$type_hs_unsigned_long"- cpp_flags="$cpp_flags $def"- ghc_flags="$ghc_flags -optP$def"-- # And size- def="-DSIZEOF_HTYPE_UNSIGNED_LONG=$sizeof_hs_CULong"- cpp_flags="$cpp_flags $def"- ghc_flags="$ghc_flags -optP$def"-----cat >confcache <<\_ACEOF-# This file is a shell script that caches the results of configure-# tests run on this system so they can be shared between configure-# scripts and configure runs, see configure's option --config-cache.-# It is not useful on other systems. If it contains results you don't-# want to keep, you may remove or edit it.-#-# config.status only pays attention to the cache file if you give it-# the --recheck option to rerun configure.-#-# `ac_cv_env_foo' variables (set or unset) will be overridden when-# loading this file, other *unset* `ac_cv_foo' will be assigned the-# following values.--_ACEOF--# The following way of writing the cache mishandles newlines in values,-# but we know of no workaround that is simple, portable, and efficient.-# So, we kill variables containing newlines.-# Ultrix sh set writes to stderr and can't be redirected directly,-# and sets the high bit in the cache file unless we assign to the vars.-(- for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do- eval ac_val=\$$ac_var- case $ac_val in #(- *${as_nl}*)- case $ac_var in #(- *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5-$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;;- esac- case $ac_var in #(- _ | IFS | as_nl) ;; #(- BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #(- *) { eval $ac_var=; unset $ac_var;} ;;- esac ;;- esac- done-- (set) 2>&1 |- case $as_nl`(ac_space=' '; set) 2>&1` in #(- *${as_nl}ac_space=\ *)- # `set' does not quote correctly, so add quotes: double-quote- # substitution turns \\\\ into \\, and sed turns \\ into \.- sed -n \- "s/'/'\\\\''/g;- s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p"- ;; #(- *)- # `set' quotes correctly as required by POSIX, so do not add quotes.- sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p"- ;;- esac |- sort-) |- sed '- /^ac_cv_env_/b end- t clear- :clear- s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/- t end- s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/- :end' >>confcache-if diff "$cache_file" confcache >/dev/null 2>&1; then :; else- if test -w "$cache_file"; then- if test "x$cache_file" != "x/dev/null"; then- { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5-$as_echo "$as_me: updating cache $cache_file" >&6;}- if test ! -f "$cache_file" || test -h "$cache_file"; then- cat confcache >"$cache_file"- else- case $cache_file in #(- */* | ?:*)- mv -f confcache "$cache_file"$$ &&- mv -f "$cache_file"$$ "$cache_file" ;; #(- *)- mv -f confcache "$cache_file" ;;- esac- fi- fi- else- { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5-$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;}- fi-fi-rm -f confcache--test "x$prefix" = xNONE && prefix=$ac_default_prefix-# Let make expand exec_prefix.-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'--# Transform confdefs.h into DEFS.-# Protect against shell expansion while executing Makefile rules.-# Protect against Makefile macro expansion.-#-# If the first sed substitution is executed (which looks for macros that-# take arguments), then branch to the quote section. Otherwise,-# look for a macro that doesn't take arguments.-ac_script='-:mline-/\\$/{- N- s,\\\n,,- b mline-}-t clear-:clear-s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g-t quote-s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g-t quote-b any-:quote-s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g-s/\[/\\&/g-s/\]/\\&/g-s/\$/$$/g-H-:any-${- g- s/^\n//- s/\n/ /g- p-}-'-DEFS=`sed -n "$ac_script" confdefs.h`---ac_libobjs=-ac_ltlibobjs=-U=-for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue- # 1. Remove the extension, and $U if already installed.- ac_script='s/\$U\././;s/\.o$//;s/\.obj$//'- ac_i=`$as_echo "$ac_i" | sed "$ac_script"`- # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR- # will be set to the directory where LIBOBJS objects are built.- as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext"- as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo'-done-LIBOBJS=$ac_libobjs--LTLIBOBJS=$ac_ltlibobjs----: "${CONFIG_STATUS=./config.status}"-ac_write_fail=0-ac_clean_files_save=$ac_clean_files-ac_clean_files="$ac_clean_files $CONFIG_STATUS"-{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5-$as_echo "$as_me: creating $CONFIG_STATUS" >&6;}-as_write_fail=0-cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1-#! $SHELL-# Generated by $as_me.-# Run this file to recreate the current configuration.-# Compiler output produced by configure, useful for debugging-# configure, is in config.log if it exists.--debug=false-ac_cs_recheck=false-ac_cs_silent=false--SHELL=\${CONFIG_SHELL-$SHELL}-export SHELL-_ASEOF-cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1-## -------------------- ##-## M4sh Initialization. ##-## -------------------- ##--# Be more Bourne compatible-DUALCASE=1; export DUALCASE # for MKS sh-if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then :- emulate sh- NULLCMD=:- # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which- # is contrary to our usage. Disable this feature.- alias -g '${1+"$@"}'='"$@"'- setopt NO_GLOB_SUBST-else- case `(set -o) 2>/dev/null` in #(- *posix*) :- set -o posix ;; #(- *) :- ;;-esac-fi---as_nl='-'-export as_nl-# Printing a long string crashes Solaris 7 /usr/bin/printf.-as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\'-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo-as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo-# Prefer a ksh shell builtin over an external printf program on Solaris,-# but without wasting forks for bash or zsh.-if test -z "$BASH_VERSION$ZSH_VERSION" \- && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then- as_echo='print -r --'- as_echo_n='print -rn --'-elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then- as_echo='printf %s\n'- as_echo_n='printf %s'-else- if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then- as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"'- as_echo_n='/usr/ucb/echo -n'- else- as_echo_body='eval expr "X$1" : "X\\(.*\\)"'- as_echo_n_body='eval- arg=$1;- case $arg in #(- *"$as_nl"*)- expr "X$arg" : "X\\(.*\\)$as_nl";- arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;;- esac;- expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl"- '- export as_echo_n_body- as_echo_n='sh -c $as_echo_n_body as_echo'- fi- export as_echo_body- as_echo='sh -c $as_echo_body as_echo'-fi--# The user is always right.-if test "${PATH_SEPARATOR+set}" != set; then- PATH_SEPARATOR=:- (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && {- (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 ||- PATH_SEPARATOR=';'- }-fi---# IFS-# We need space, tab and new line, in precisely that order. Quoting is-# there to prevent editors from complaining about space-tab.-# (If _AS_PATH_WALK were called with IFS unset, it would disable word-# splitting by setting IFS to empty value.)-IFS=" "" $as_nl"--# Find who we are. Look in the path if we contain no directory separator.-as_myself=-case $0 in #((- *[\\/]* ) as_myself=$0 ;;- *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR-for as_dir in $PATH-do- IFS=$as_save_IFS- test -z "$as_dir" && as_dir=.- test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break- done-IFS=$as_save_IFS-- ;;-esac-# We did not find ourselves, most probably we were run as `sh COMMAND'-# in which case we are not to be found in the path.-if test "x$as_myself" = x; then- as_myself=$0-fi-if test ! -f "$as_myself"; then- $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2- exit 1-fi--# Unset variables that we do not need and which cause bugs (e.g. in-# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1"-# suppresses any "Segmentation fault" message there. '((' could-# trigger a bug in pdksh 5.2.14.-for as_var in BASH_ENV ENV MAIL MAILPATH-do eval test x\${$as_var+set} = xset \- && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || :-done-PS1='$ '-PS2='> '-PS4='+ '--# NLS nuisances.-LC_ALL=C-export LC_ALL-LANGUAGE=C-export LANGUAGE--# CDPATH.-(unset CDPATH) >/dev/null 2>&1 && unset CDPATH---# as_fn_error STATUS ERROR [LINENO LOG_FD]-# -----------------------------------------# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are-# provided, also output the error to LOG_FD, referencing LINENO. Then exit the-# script with STATUS, using 1 if that was 0.-as_fn_error ()-{- as_status=$1; test $as_status -eq 0 && as_status=1- if test "$4"; then- as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack- $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4- fi- $as_echo "$as_me: error: $2" >&2- as_fn_exit $as_status-} # as_fn_error---# as_fn_set_status STATUS-# ------------------------# Set $? to STATUS, without forking.-as_fn_set_status ()-{- return $1-} # as_fn_set_status--# as_fn_exit STATUS-# ------------------# Exit the shell with STATUS, even in a "trap 0" or "set -e" context.-as_fn_exit ()-{- set +e- as_fn_set_status $1- exit $1-} # as_fn_exit--# as_fn_unset VAR-# ----------------# Portably unset VAR.-as_fn_unset ()-{- { eval $1=; unset $1;}-}-as_unset=as_fn_unset-# as_fn_append VAR VALUE-# -----------------------# Append the text in VALUE to the end of the definition contained in VAR. Take-# advantage of any shell optimizations that allow amortized linear growth over-# repeated appends, instead of the typical quadratic growth present in naive-# implementations.-if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then :- eval 'as_fn_append ()- {- eval $1+=\$2- }'-else- as_fn_append ()- {- eval $1=\$$1\$2- }-fi # as_fn_append--# as_fn_arith ARG...-# -------------------# Perform arithmetic evaluation on the ARGs, and store the result in the-# global $as_val. Take advantage of shells that can avoid forks. The arguments-# must be portable across $(()) and expr.-if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then :- eval 'as_fn_arith ()- {- as_val=$(( $* ))- }'-else- as_fn_arith ()- {- as_val=`expr "$@" || test $? -eq 1`- }-fi # as_fn_arith---if expr a : '\(a\)' >/dev/null 2>&1 &&- test "X`expr 00001 : '.*\(...\)'`" = X001; then- as_expr=expr-else- as_expr=false-fi--if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then- as_basename=basename-else- as_basename=false-fi--if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then- as_dirname=dirname-else- as_dirname=false-fi--as_me=`$as_basename -- "$0" ||-$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \- X"$0" : 'X\(//\)$' \| \- X"$0" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X/"$0" |- sed '/^.*\/\([^/][^/]*\)\/*$/{- s//\1/- q- }- /^X\/\(\/\/\)$/{- s//\1/- q- }- /^X\/\(\/\).*/{- s//\1/- q- }- s/.*/./; q'`--# Avoid depending upon Character Ranges.-as_cr_letters='abcdefghijklmnopqrstuvwxyz'-as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ'-as_cr_Letters=$as_cr_letters$as_cr_LETTERS-as_cr_digits='0123456789'-as_cr_alnum=$as_cr_Letters$as_cr_digits--ECHO_C= ECHO_N= ECHO_T=-case `echo -n x` in #(((((--n*)- case `echo 'xy\c'` in- *c*) ECHO_T=' ';; # ECHO_T is single tab character.- xy) ECHO_C='\c';;- *) echo `echo ksh88 bug on AIX 6.1` > /dev/null- ECHO_T=' ';;- esac;;-*)- ECHO_N='-n';;-esac--rm -f conf$$ conf$$.exe conf$$.file-if test -d conf$$.dir; then- rm -f conf$$.dir/conf$$.file-else- rm -f conf$$.dir- mkdir conf$$.dir 2>/dev/null-fi-if (echo >conf$$.file) 2>/dev/null; then- if ln -s conf$$.file conf$$ 2>/dev/null; then- as_ln_s='ln -s'- # ... but there are two gotchas:- # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.- # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.- # In both cases, we have to default to `cp -pR'.- ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||- as_ln_s='cp -pR'- elif ln conf$$.file conf$$ 2>/dev/null; then- as_ln_s=ln- else- as_ln_s='cp -pR'- fi-else- as_ln_s='cp -pR'-fi-rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file-rmdir conf$$.dir 2>/dev/null---# as_fn_mkdir_p-# --------------# Create "$as_dir" as a directory, including parents if necessary.-as_fn_mkdir_p ()-{-- case $as_dir in #(- -*) as_dir=./$as_dir;;- esac- test -d "$as_dir" || eval $as_mkdir_p || {- as_dirs=- while :; do- case $as_dir in #(- *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'(- *) as_qdir=$as_dir;;- esac- as_dirs="'$as_qdir' $as_dirs"- as_dir=`$as_dirname -- "$as_dir" ||-$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \- X"$as_dir" : 'X\(//\)[^/]' \| \- X"$as_dir" : 'X\(//\)$' \| \- X"$as_dir" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$as_dir" |- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{- s//\1/- q- }- /^X\(\/\/\)[^/].*/{- s//\1/- q- }- /^X\(\/\/\)$/{- s//\1/- q- }- /^X\(\/\).*/{- s//\1/- q- }- s/.*/./; q'`- test -d "$as_dir" && break- done- test -z "$as_dirs" || eval "mkdir $as_dirs"- } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir"---} # as_fn_mkdir_p-if mkdir -p . 2>/dev/null; then- as_mkdir_p='mkdir -p "$as_dir"'-else- test -d ./-p && rmdir ./-p- as_mkdir_p=false-fi---# as_fn_executable_p FILE-# ------------------------# Test if FILE is an executable regular file.-as_fn_executable_p ()-{- test -f "$1" && test -x "$1"-} # as_fn_executable_p-as_test_x='test -x'-as_executable_p=as_fn_executable_p--# Sed expression to map a string onto a valid CPP name.-as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"--# Sed expression to map a string onto a valid variable name.-as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'"---exec 6>&1-## ----------------------------------- ##-## Main body of $CONFIG_STATUS script. ##-## ----------------------------------- ##-_ASEOF-test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# Save the log message, to keep $0 and so on meaningful, and to-# report actual input values of CONFIG_FILES etc. instead of their-# values after options handling.-ac_log="-This file was extended by accelerate $as_me 0.14.0.0, which was-generated by GNU Autoconf 2.69. Invocation command line was-- CONFIG_FILES = $CONFIG_FILES- CONFIG_HEADERS = $CONFIG_HEADERS- CONFIG_LINKS = $CONFIG_LINKS- CONFIG_COMMANDS = $CONFIG_COMMANDS- $ $0 $@--on `(hostname || uname -n) 2>/dev/null | sed 1q`-"--_ACEOF--case $ac_config_files in *"-"*) set x $ac_config_files; shift; ac_config_files=$*;;-esac----cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-# Files that config.status was made for.-config_files="$ac_config_files"--_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-ac_cs_usage="\-\`$as_me' instantiates files and other configuration actions-from templates according to the current configuration. Unless the files-and actions are specified as TAGs, all are instantiated by default.--Usage: $0 [OPTION]... [TAG]...-- -h, --help print this help, then exit- -V, --version print version number and configuration settings, then exit- --config print configuration, then exit- -q, --quiet, --silent- do not print progress messages- -d, --debug don't remove temporary files- --recheck update $as_me by reconfiguring in the same conditions- --file=FILE[:TEMPLATE]- instantiate the configuration file FILE--Configuration files:-$config_files--Report bugs to <accelerate-haskell@googlegroups.com>."--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"-ac_cs_version="\\-accelerate config.status 0.14.0.0-configured by $0, generated by GNU Autoconf 2.69,- with options \\"\$ac_cs_config\\"--Copyright (C) 2012 Free Software Foundation, Inc.-This config.status script is free software; the Free Software Foundation-gives unlimited permission to copy, distribute and modify it."--ac_pwd='$ac_pwd'-srcdir='$srcdir'-test -n "\$AWK" || AWK=awk-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# The default lists apply if the user does not specify any file.-ac_need_defaults=:-while test $# != 0-do- case $1 in- --*=?*)- ac_option=`expr "X$1" : 'X\([^=]*\)='`- ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'`- ac_shift=:- ;;- --*=)- ac_option=`expr "X$1" : 'X\([^=]*\)='`- ac_optarg=- ac_shift=:- ;;- *)- ac_option=$1- ac_optarg=$2- ac_shift=shift- ;;- esac-- case $ac_option in- # Handling of the options.- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)- ac_cs_recheck=: ;;- --version | --versio | --versi | --vers | --ver | --ve | --v | -V )- $as_echo "$ac_cs_version"; exit ;;- --config | --confi | --conf | --con | --co | --c )- $as_echo "$ac_cs_config"; exit ;;- --debug | --debu | --deb | --de | --d | -d )- debug=: ;;- --file | --fil | --fi | --f )- $ac_shift- case $ac_optarg in- *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;;- '') as_fn_error $? "missing file argument" ;;- esac- as_fn_append CONFIG_FILES " '$ac_optarg'"- ac_need_defaults=false;;- --he | --h | --help | --hel | -h )- $as_echo "$ac_cs_usage"; exit ;;- -q | -quiet | --quiet | --quie | --qui | --qu | --q \- | -silent | --silent | --silen | --sile | --sil | --si | --s)- ac_cs_silent=: ;;-- # This is an error.- -*) as_fn_error $? "unrecognized option: \`$1'-Try \`$0 --help' for more information." ;;-- *) as_fn_append ac_config_targets " $1"- ac_need_defaults=false ;;-- esac- shift-done--ac_configure_extra_args=--if $ac_cs_silent; then- exec 6>/dev/null- ac_configure_extra_args="$ac_configure_extra_args --silent"-fi--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-if \$ac_cs_recheck; then- set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion- shift- \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6- CONFIG_SHELL='$SHELL'- export CONFIG_SHELL- exec "\$@"-fi--_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-exec 5>>config.log-{- echo- sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX-## Running $as_me. ##-_ASBOX- $as_echo "$ac_log"-} >&5--_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1--# Handling of arguments.-for ac_config_target in $ac_config_targets-do- case $ac_config_target in- "accelerate.buildinfo") CONFIG_FILES="$CONFIG_FILES accelerate.buildinfo" ;;-- *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;;- esac-done---# If the user did not use the arguments to specify the items to instantiate,-# then the envvar interface is used. Set only those that are not.-# We use the long form for the default assignment because of an extremely-# bizarre bug on SunOS 4.1.3.-if $ac_need_defaults; then- test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files-fi--# Have a temporary directory for convenience. Make it in the build tree-# simply because there is no reason against having it here, and in addition,-# creating and moving files from /tmp can sometimes cause problems.-# Hook for its removal unless debugging.-# Note that there is a small window in which the directory will not be cleaned:-# after its creation but before its name has been assigned to `$tmp'.-$debug ||-{- tmp= ac_tmp=- trap 'exit_status=$?- : "${ac_tmp:=$tmp}"- { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status-' 0- trap 'as_fn_exit 1' 1 2 13 15-}-# Create a (secure) tmp directory for tmp files.--{- tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` &&- test -d "$tmp"-} ||-{- tmp=./conf$$-$RANDOM- (umask 077 && mkdir "$tmp")-} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5-ac_tmp=$tmp--# Set up the scripts for CONFIG_FILES section.-# No need to generate them if there are no CONFIG_FILES.-# This happens for instance with `./config.status config.h'.-if test -n "$CONFIG_FILES"; then---ac_cr=`echo X | tr X '\015'`-# On cygwin, bash can eat \r inside `` if the user requested igncr.-# But we know of no other shell where ac_cr would be empty at this-# point, so we can use a bashism as a fallback.-if test "x$ac_cr" = x; then- eval ac_cr=\$\'\\r\'-fi-ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' </dev/null 2>/dev/null`-if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then- ac_cs_awk_cr='\\r'-else- ac_cs_awk_cr=$ac_cr-fi--echo 'BEGIN {' >"$ac_tmp/subs1.awk" &&-_ACEOF---{- echo "cat >conf$$subs.awk <<_ACEOF" &&- echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' &&- echo "_ACEOF"-} >conf$$subs.sh ||- as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5-ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'`-ac_delim='%!_!# '-for ac_last_try in false false false false false :; do- . ./conf$$subs.sh ||- as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5-- ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X`- if test $ac_delim_n = $ac_delim_num; then- break- elif $ac_last_try; then- as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5- else- ac_delim="$ac_delim!$ac_delim _$ac_delim!! "- fi-done-rm -f conf$$subs.sh--cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&-_ACEOF-sed -n '-h-s/^/S["/; s/!.*/"]=/-p-g-s/^[^!]*!//-:repl-t repl-s/'"$ac_delim"'$//-t delim-:nl-h-s/\(.\{148\}\)..*/\1/-t more1-s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/-p-n-b repl-:more1-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t nl-:delim-h-s/\(.\{148\}\)..*/\1/-t more2-s/["\\]/\\&/g; s/^/"/; s/$/"/-p-b-:more2-s/["\\]/\\&/g; s/^/"/; s/$/"\\/-p-g-s/.\{148\}//-t delim-' <conf$$subs.awk | sed '-/^[^""]/{- N- s/\n//-}-' >>$CONFIG_STATUS || ac_write_fail=1-rm -f conf$$subs.awk-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-_ACAWK-cat >>"\$ac_tmp/subs1.awk" <<_ACAWK &&- for (key in S) S_is_set[key] = 1- FS = ""--}-{- line = $ 0- nfields = split(line, field, "@")- substed = 0- len = length(field[1])- for (i = 2; i < nfields; i++) {- key = field[i]- keylen = length(key)- if (S_is_set[key]) {- value = S[key]- line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3)- len += length(value) + length(field[++i])- substed = 1- } else- len += 1 + keylen- }-- print line-}--_ACAWK-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then- sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g"-else- cat-fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \- || as_fn_error $? "could not setup config files machinery" "$LINENO" 5-_ACEOF--# VPATH may cause trouble with some makes, so we remove sole $(srcdir),-# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and-# trailing colons and then remove the whole line if VPATH becomes empty-# (actually we leave an empty line to preserve line numbers).-if test "x$srcdir" = x.; then- ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{-h-s///-s/^/:/-s/[ ]*$/:/-s/:\$(srcdir):/:/g-s/:\${srcdir}:/:/g-s/:@srcdir@:/:/g-s/^:*//-s/:*$//-x-s/\(=[ ]*\).*/\1/-G-s/\n//-s/^[^=]*=[ ]*$//-}'-fi--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-fi # test -n "$CONFIG_FILES"---eval set X " :F $CONFIG_FILES "-shift-for ac_tag-do- case $ac_tag in- :[FHLC]) ac_mode=$ac_tag; continue;;- esac- case $ac_mode$ac_tag in- :[FHL]*:*);;- :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;;- :[FH]-) ac_tag=-:-;;- :[FH]*) ac_tag=$ac_tag:$ac_tag.in;;- esac- ac_save_IFS=$IFS- IFS=:- set x $ac_tag- IFS=$ac_save_IFS- shift- ac_file=$1- shift-- case $ac_mode in- :L) ac_source=$1;;- :[FH])- ac_file_inputs=- for ac_f- do- case $ac_f in- -) ac_f="$ac_tmp/stdin";;- *) # Look for the file first in the build tree, then in the source tree- # (if the path is not absolute). The absolute path cannot be DOS-style,- # because $ac_f cannot contain `:'.- test -f "$ac_f" ||- case $ac_f in- [\\/$]*) false;;- *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";;- esac ||- as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;;- esac- case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac- as_fn_append ac_file_inputs " '$ac_f'"- done-- # Let's still pretend it is `configure' which instantiates (i.e., don't- # use $as_me), people would be surprised to read:- # /* config.h. Generated by config.status. */- configure_input='Generated from '`- $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g'- `' by configure.'- if test x"$ac_file" != x-; then- configure_input="$ac_file. $configure_input"- { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5-$as_echo "$as_me: creating $ac_file" >&6;}- fi- # Neutralize special characters interpreted by sed in replacement strings.- case $configure_input in #(- *\&* | *\|* | *\\* )- ac_sed_conf_input=`$as_echo "$configure_input" |- sed 's/[\\\\&|]/\\\\&/g'`;; #(- *) ac_sed_conf_input=$configure_input;;- esac-- case $ac_tag in- *:-:* | *:-) cat >"$ac_tmp/stdin" \- || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;;- esac- ;;- esac-- ac_dir=`$as_dirname -- "$ac_file" ||-$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \- X"$ac_file" : 'X\(//\)[^/]' \| \- X"$ac_file" : 'X\(//\)$' \| \- X"$ac_file" : 'X\(/\)' \| . 2>/dev/null ||-$as_echo X"$ac_file" |- sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{- s//\1/- q- }- /^X\(\/\/\)[^/].*/{- s//\1/- q- }- /^X\(\/\/\)$/{- s//\1/- q- }- /^X\(\/\).*/{- s//\1/- q- }- s/.*/./; q'`- as_dir="$ac_dir"; as_fn_mkdir_p- ac_builddir=.--case "$ac_dir" in-.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;;-*)- ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'`- # A ".." for each directory in $ac_dir_suffix.- ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'`- case $ac_top_builddir_sub in- "") ac_top_builddir_sub=. ac_top_build_prefix= ;;- *) ac_top_build_prefix=$ac_top_builddir_sub/ ;;- esac ;;-esac-ac_abs_top_builddir=$ac_pwd-ac_abs_builddir=$ac_pwd$ac_dir_suffix-# for backward compatibility:-ac_top_builddir=$ac_top_build_prefix--case $srcdir in- .) # We are building in place.- ac_srcdir=.- ac_top_srcdir=$ac_top_builddir_sub- ac_abs_top_srcdir=$ac_pwd ;;- [\\/]* | ?:[\\/]* ) # Absolute name.- ac_srcdir=$srcdir$ac_dir_suffix;- ac_top_srcdir=$srcdir- ac_abs_top_srcdir=$srcdir ;;- *) # Relative name.- ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix- ac_top_srcdir=$ac_top_build_prefix$srcdir- ac_abs_top_srcdir=$ac_pwd/$srcdir ;;-esac-ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix--- case $ac_mode in- :F)- #- # CONFIG_FILE- #--_ACEOF--cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-# If the template does not know about datarootdir, expand it.-# FIXME: This hack should be removed a few years after 2.60.-ac_datarootdir_hack=; ac_datarootdir_seen=-ac_sed_dataroot='-/datarootdir/ {- p- q-}-/@datadir@/p-/@docdir@/p-/@infodir@/p-/@localedir@/p-/@mandir@/p'-case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in-*datarootdir*) ac_datarootdir_seen=yes;;-*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*)- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5-$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;}-_ACEOF-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1- ac_datarootdir_hack='- s&@datadir@&$datadir&g- s&@docdir@&$docdir&g- s&@infodir@&$infodir&g- s&@localedir@&$localedir&g- s&@mandir@&$mandir&g- s&\\\${datarootdir}&$datarootdir&g' ;;-esac-_ACEOF--# Neutralize VPATH when `$srcdir' = `.'.-# Shell code in configure.ac might set extrasub.-# FIXME: do we really want to maintain this feature?-cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1-ac_sed_extra="$ac_vpsub-$extrasub-_ACEOF-cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1-:t-/@[a-zA-Z_][a-zA-Z_0-9]*@/!b-s|@configure_input@|$ac_sed_conf_input|;t t-s&@top_builddir@&$ac_top_builddir_sub&;t t-s&@top_build_prefix@&$ac_top_build_prefix&;t t-s&@srcdir@&$ac_srcdir&;t t-s&@abs_srcdir@&$ac_abs_srcdir&;t t-s&@top_srcdir@&$ac_top_srcdir&;t t-s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t-s&@builddir@&$ac_builddir&;t t-s&@abs_builddir@&$ac_abs_builddir&;t t-s&@abs_top_builddir@&$ac_abs_top_builddir&;t t-$ac_datarootdir_hack-"-eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \- >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5--test -z "$ac_datarootdir_hack$ac_datarootdir_seen" &&- { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } &&- { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \- "$ac_tmp/out"`; test -z "$ac_out"; } &&- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined. Please make sure it is defined" >&5-$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir'-which seems to be undefined. Please make sure it is defined" >&2;}-- rm -f "$ac_tmp/stdin"- case $ac_file in- -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";;- *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";;- esac \- || as_fn_error $? "could not create $ac_file" "$LINENO" 5- ;;---- esac--done # for ac_tag---as_fn_exit 0-_ACEOF-ac_clean_files=$ac_clean_files_save--test $ac_write_fail = 0 ||- as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5---# configure is writing to config.log, and then calls config.status.-# config.status does its own redirection, appending to config.log.-# Unfortunately, on DOS this fails, as config.log is still kept open-# by configure, so config.status won't be able to write to it; its-# output is simply discarded. So we exec the FD to /dev/null,-# effectively closing config.log, so it can be properly (re)opened and-# appended to by config.status. When coming back to configure, we-# need to make the FD available again.-if test "$no_create" != yes; then- ac_cs_success=:- ac_config_status_args=- test "$silent" = yes &&- ac_config_status_args="$ac_config_status_args --quiet"- exec 5>/dev/null- $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false- exec 5>>config.log- # Use ||, not &&, to avoid exiting from the if with $? = 1, which- # would make configure fail if this is the last instruction.- $ac_cs_success || as_fn_exit 1-fi-if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then- { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5-$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;}-fi--
− include/accelerate.h
@@ -1,27 +0,0 @@--#ifndef ACCELERATE_H-#define ACCELERATE_H-import qualified Data.Array.Accelerate.Internal.Check as Ck--#define ERROR(f) (Ck.f __FILE__ __LINE__)-#define ASSERT (Ck.assert __FILE__ __LINE__)-#define ENSURE (Ck.f __FILE__ __LINE__)-#define CHECK(f) (Ck.f __FILE__ __LINE__)--#define BOUNDS_ERROR(f) (ERROR(f) Ck.Bounds)-#define BOUNDS_ASSERT (ASSERT Ck.Bounds)-#define BOUNDS_ENSURE (ENSURE Ck.Bounds)-#define BOUNDS_CHECK(f) (CHECK(f) Ck.Bounds)--#define UNSAFE_ERROR(f) (ERROR(f) Ck.Unsafe)-#define UNSAFE_ASSERT (ASSERT Ck.Unsafe)-#define UNSAFE_ENSURE (ENSURE Ck.Unsafe)-#define UNSAFE_CHECK(f) (CHECK(f) Ck.Unsafe)--#define INTERNAL_ERROR(f) (ERROR(f) Ck.Internal)-#define INTERNAL_ASSERT (ASSERT Ck.Internal)-#define INTERNAL_ENSURE (ENSURE Ck.Internal)-#define INTERNAL_CHECK(f) (CHECK(f) Ck.Internal)--#endif-