diff --git a/Data/Array/Accelerate.hs b/Data/Array/Accelerate.hs --- a/Data/Array/Accelerate.hs +++ b/Data/Array/Accelerate.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/AST.hs b/Data/Array/Accelerate/AST.hs --- a/Data/Array/Accelerate/AST.hs +++ b/Data/Array/Accelerate/AST.hs @@ -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 @@ -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 -- diff --git a/Data/Array/Accelerate/Analysis/Match.hs b/Data/Array/Accelerate/Analysis/Match.hs --- a/Data/Array/Accelerate/Analysis/Match.hs +++ b/Data/Array/Accelerate/Analysis/Match.hs @@ -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 diff --git a/Data/Array/Accelerate/Analysis/Shape.hs b/Data/Array/Accelerate/Analysis/Shape.hs --- a/Data/Array/Accelerate/Analysis/Shape.hs +++ b/Data/Array/Accelerate/Analysis/Shape.hs @@ -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 diff --git a/Data/Array/Accelerate/Analysis/Stencil.hs b/Data/Array/Accelerate/Analysis/Stencil.hs --- a/Data/Array/Accelerate/Analysis/Stencil.hs +++ b/Data/Array/Accelerate/Analysis/Stencil.hs @@ -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 diff --git a/Data/Array/Accelerate/Analysis/Type.hs b/Data/Array/Accelerate/Analysis/Type.hs --- a/Data/Array/Accelerate/Analysis/Type.hs +++ b/Data/Array/Accelerate/Analysis/Type.hs @@ -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 diff --git a/Data/Array/Accelerate/Array/Data.hs b/Data/Array/Accelerate/Array/Data.hs --- a/Data/Array/Accelerate/Array/Data.hs +++ b/Data/Array/Accelerate/Array/Data.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Array/Delayed.hs b/Data/Array/Accelerate/Array/Delayed.hs deleted file mode 100644 --- a/Data/Array/Accelerate/Array/Delayed.hs +++ /dev/null @@ -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 --- 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) - diff --git a/Data/Array/Accelerate/Array/Representation.hs b/Data/Array/Accelerate/Array/Representation.hs --- a/Data/Array/Accelerate/Array/Representation.hs +++ b/Data/Array/Accelerate/Array/Representation.hs @@ -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 @@ -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) diff --git a/Data/Array/Accelerate/Array/Sugar.hs b/Data/Array/Accelerate/Array/Sugar.hs --- a/Data/Array/Accelerate/Array/Sugar.hs +++ b/Data/Array/Accelerate/Array/Sugar.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Data/Complex.hs b/Data/Array/Accelerate/Data/Complex.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Complex.hs @@ -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) + diff --git a/Data/Array/Accelerate/Debug.hs b/Data/Array/Accelerate/Debug.hs --- a/Data/Array/Accelerate/Debug.hs +++ b/Data/Array/Accelerate/Debug.hs @@ -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 diff --git a/Data/Array/Accelerate/Error.hs b/Data/Array/Accelerate/Error.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Error.hs @@ -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 +-- 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 + diff --git a/Data/Array/Accelerate/Internal/Check.hs b/Data/Array/Accelerate/Internal/Check.hs deleted file mode 100644 --- a/Data/Array/Accelerate/Internal/Check.hs +++ /dev/null @@ -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 --- 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. --- - -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 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 - diff --git a/Data/Array/Accelerate/Interpreter.hs b/Data/Array/Accelerate/Interpreter.hs --- a/Data/Array/Accelerate/Interpreter.hs +++ b/Data/Array/Accelerate/Interpreter.hs @@ -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 --- 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 +-- 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 diff --git a/Data/Array/Accelerate/Language.hs b/Data/Array/Accelerate/Language.hs --- a/Data/Array/Accelerate/Language.hs +++ b/Data/Array/Accelerate/Language.hs @@ -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 @@ -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'. diff --git a/Data/Array/Accelerate/Prelude.hs b/Data/Array/Accelerate/Prelude.hs --- a/Data/Array/Accelerate/Prelude.hs +++ b/Data/Array/Accelerate/Prelude.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Pretty.hs b/Data/Array/Accelerate/Pretty.hs --- a/Data/Array/Accelerate/Pretty.hs +++ b/Data/Array/Accelerate/Pretty.hs @@ -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 diff --git a/Data/Array/Accelerate/Pretty/Print.hs b/Data/Array/Accelerate/Pretty/Print.hs --- a/Data/Array/Accelerate/Pretty/Print.hs +++ b/Data/Array/Accelerate/Pretty/Print.hs @@ -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 @@ -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) diff --git a/Data/Array/Accelerate/Smart.hs b/Data/Array/Accelerate/Smart.hs --- a/Data/Array/Accelerate/Smart.hs +++ b/Data/Array/Accelerate/Smart.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Trafo.hs b/Data/Array/Accelerate/Trafo.hs --- a/Data/Array/Accelerate/Trafo.hs +++ b/Data/Array/Accelerate/Trafo.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Algebra.hs b/Data/Array/Accelerate/Trafo/Algebra.hs --- a/Data/Array/Accelerate/Trafo/Algebra.hs +++ b/Data/Array/Accelerate/Trafo/Algebra.hs @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Base.hs b/Data/Array/Accelerate/Trafo/Base.hs --- a/Data/Array/Accelerate/Trafo/Base.hs +++ b/Data/Array/Accelerate/Trafo/Base.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Fusion.hs b/Data/Array/Accelerate/Trafo/Fusion.hs --- a/Data/Array/Accelerate/Trafo/Fusion.hs +++ b/Data/Array/Accelerate/Trafo/Fusion.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Rewrite.hs b/Data/Array/Accelerate/Trafo/Rewrite.hs --- a/Data/Array/Accelerate/Trafo/Rewrite.hs +++ b/Data/Array/Accelerate/Trafo/Rewrite.hs @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Sharing.hs b/Data/Array/Accelerate/Trafo/Sharing.hs --- a/Data/Array/Accelerate/Trafo/Sharing.hs +++ b/Data/Array/Accelerate/Trafo/Sharing.hs @@ -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 @@ -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)) diff --git a/Data/Array/Accelerate/Trafo/Shrink.hs b/Data/Array/Accelerate/Trafo/Shrink.hs --- a/Data/Array/Accelerate/Trafo/Shrink.hs +++ b/Data/Array/Accelerate/Trafo/Shrink.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Simplify.hs b/Data/Array/Accelerate/Trafo/Simplify.hs --- a/Data/Array/Accelerate/Trafo/Simplify.hs +++ b/Data/Array/Accelerate/Trafo/Simplify.hs @@ -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 @@ -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 diff --git a/Data/Array/Accelerate/Trafo/Substitution.hs b/Data/Array/Accelerate/Trafo/Substitution.hs --- a/Data/Array/Accelerate/Trafo/Substitution.hs +++ b/Data/Array/Accelerate/Trafo/Substitution.hs @@ -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 @@ -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'). diff --git a/Data/Array/Accelerate/Tuple.hs b/Data/Array/Accelerate/Tuple.hs --- a/Data/Array/Accelerate/Tuple.hs +++ b/Data/Array/Accelerate/Tuple.hs @@ -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 diff --git a/Data/Array/Accelerate/Type.hs b/Data/Array/Accelerate/Type.hs --- a/Data/Array/Accelerate/Type.hs +++ b/Data/Array/Accelerate/Type.hs @@ -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 @@ -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 diff --git a/INSTALL b/INSTALL deleted file mode 100644 --- a/INSTALL +++ /dev/null @@ -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 -(aka TacticalGrace on #haskell and friends). diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -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 diff --git a/accelerate.buildinfo.in b/accelerate.buildinfo.in deleted file mode 100644 --- a/accelerate.buildinfo.in +++ /dev/null @@ -1,3 +0,0 @@ -ghc-options: @ghc_flags@ -cc-options: @cpp_flags@ - diff --git a/accelerate.cabal b/accelerate.cabal --- a/accelerate.cabal +++ b/accelerate.cabal @@ -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 @@ . 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: . @@ -45,13 +46,16 @@ . 3. A backend to the Repa array library: . + 4. An infrastructure for generating LLVM code, with backends targeting + multicore CPUs and NVIDIA GPUs: + . [/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: . @@ -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: (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 diff --git a/configure b/configure deleted file mode 100644 --- a/configure +++ /dev/null @@ -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 . -# -# -# 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 &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 . -_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 ." - -_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` -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 -' >$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 - - diff --git a/include/accelerate.h b/include/accelerate.h deleted file mode 100644 --- a/include/accelerate.h +++ /dev/null @@ -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 -