update for Bool, Char arrays

AccelerateHS · May 15, 2012 · 599f2cd · 599f2cd
1 parent cb9f22a
commit 599f2cd
Show file tree

Hide file tree

Showing 5 changed files with 53 additions and 32 deletions.
diff --git a/Data/Array/Accelerate/CUDA/Array/Data.hs b/Data/Array/Accelerate/CUDA/Array/Data.hs
@@ -1,4 +1,7 @@
-{-# LANGUAGE CPP, GADTs, TypeFamilies, ScopedTypeVariables #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
 -- |
 -- Module      : Data.Array.Accelerate.CUDA.Array.Data
 -- Copyright   : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
@@ -26,15 +29,15 @@ module Data.Array.Accelerate.CUDA.Array.Data (
 ) where
 
 -- libraries
-import Prelude                                          hiding (fst, snd)
+import Prelude                                          hiding ( fst, snd )
 import Data.Label.PureM
 import Control.Applicative
 import Control.Monad.Trans
 
 -- friends
 import Data.Array.Accelerate.Array.Data
-import Data.Array.Accelerate.Array.Sugar                (Array(..), Shape, Elt, fromElt, toElt)
-import Data.Array.Accelerate.Array.Representation       (size, index)
+import Data.Array.Accelerate.Array.Sugar                ( Array(..), Shape, Elt, fromElt, toElt )
+import Data.Array.Accelerate.Array.Representation       ( size, index )
 import Data.Array.Accelerate.CUDA.State
 import Data.Array.Accelerate.CUDA.Array.Table
 import qualified Data.Array.Accelerate.CUDA.Array.Prim  as Prim
@@ -77,8 +80,8 @@ snd = sndArrayData
 ; dispatcher ArrayEltRword64 = worker                                       \
 ; dispatcher ArrayEltRfloat  = worker                                       \
 ; dispatcher ArrayEltRdouble = worker                                       \
-; dispatcher ArrayEltRbool   = error "mkPrimDispatcher: ArrayEltRbool"      \
-; dispatcher ArrayEltRchar   = error "mkPrimDispatcher: ArrayEltRchar"      \
+; dispatcher ArrayEltRbool   = worker                                       \
+; dispatcher ArrayEltRchar   = worker                                       \
 ; dispatcher _               = error "mkPrimDispatcher: not primitive"
 
 
@@ -140,10 +143,24 @@ indexArray (Array sh adata) ix = doIndex =<< gets memoryTable
         indexR ArrayEltRunit             _  = return ()
         indexR (ArrayEltRpair aeR1 aeR2) ad = (,) <$> indexR aeR1 (fst ad)
                                                   <*> indexR aeR2 (snd ad)
-        indexR aer                       ad = indexPrim aer mt ad i
         --
-        indexPrim :: ArrayEltR e -> MemoryTable -> ArrayData e -> Int -> IO e
-        mkPrimDispatch(indexPrim,Prim.indexArray)
+        indexR ArrayEltRbool             ad = toBool <$> Prim.indexArray mt ad i
+          where toBool 0 = False
+                toBool _ = True
+        --
+        indexR ArrayEltRint              ad = Prim.indexArray mt ad i
+        indexR ArrayEltRint8             ad = Prim.indexArray mt ad i
+        indexR ArrayEltRint16            ad = Prim.indexArray mt ad i
+        indexR ArrayEltRint32            ad = Prim.indexArray mt ad i
+        indexR ArrayEltRint64            ad = Prim.indexArray mt ad i
+        indexR ArrayEltRword             ad = Prim.indexArray mt ad i
+        indexR ArrayEltRword8            ad = Prim.indexArray mt ad i
+        indexR ArrayEltRword16           ad = Prim.indexArray mt ad i
+        indexR ArrayEltRword32           ad = Prim.indexArray mt ad i
+        indexR ArrayEltRword64           ad = Prim.indexArray mt ad i
+        indexR ArrayEltRfloat            ad = Prim.indexArray mt ad i
+        indexR ArrayEltRdouble           ad = Prim.indexArray mt ad i
+        indexR ArrayEltRchar             ad = Prim.indexArray mt ad i
 
 
 -- |Copy data between two device arrays. The operation is asynchronous with

diff --git a/Data/Array/Accelerate/CUDA/Array/Prim.hs b/Data/Array/Accelerate/CUDA/Array/Prim.hs
@@ -1,4 +1,8 @@
-{-# LANGUAGE BangPatterns, CPP, GADTs, TypeFamilies, ScopedTypeVariables #-}
+{-# LANGUAGE BangPatterns        #-}
+{-# LANGUAGE CPP                 #-}
+{-# LANGUAGE GADTs               #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies        #-}
 -- |
 -- Module      : Data.Array.Accelerate.CUDA.Array.Prim
 -- Copyright   : [2008..2010] Manuel M T Chakravarty, Gabriele Keller, Sean Lee
@@ -88,14 +92,10 @@ primArrayElt(Double)
 -- CFloat
 -- CDouble
 
--- FIXME:
--- No concrete implementation in Data.Array.Accelerate.Array.Data
---
-type instance HostPtrs   Bool = ()
-type instance DevicePtrs Bool = ()
+type instance HostPtrs   Bool = CUDA.HostPtr   Word8
+type instance DevicePtrs Bool = CUDA.DevicePtr Word8
 
-type instance HostPtrs   Char = ()
-type instance DevicePtrs Char = ()
+primArrayElt(Char)
 
 -- FIXME:
 -- CChar
@@ -126,6 +126,7 @@ instance TextureData Word32 where format _ = (CUDA.Word32, 1)
 instance TextureData Word64 where format _ = (CUDA.Word32, 2)
 instance TextureData Float  where format _ = (CUDA.Float,  1)
 instance TextureData Double where format _ = (CUDA.Int32,  2)
+instance TextureData Bool   where format _ = (CUDA.Word8,  1)
 #if   SIZEOF_HSINT == 4
 instance TextureData Int    where format _ = (CUDA.Int32, 1)
 #elif SIZEOF_HSINT == 8
@@ -136,6 +137,9 @@ instance TextureData Word   where format _ = (CUDA.Word32, 1)
 #elif SIZEOF_HSINT == 8
 instance TextureData Word   where format _ = (CUDA.Word32, 2)
 #endif
+#if SIZEOF_HSCHAR == 4
+instance TextureData Char   where format _ = (CUDA.Word32, 1)
+#endif
 
 
 -- Primitive array operations

diff --git a/Data/Array/Accelerate/CUDA/CodeGen/Type.hs b/Data/Array/Accelerate/CUDA/CodeGen/Type.hs
@@ -35,7 +35,6 @@ import qualified Data.Array.Accelerate.Analysis.Type    as Sugar
 -- libraries
 import Language.C.Quote.CUDA
 import qualified Language.C                             as C
-import qualified Foreign.Storable                       as F
 
 
 #include "accelerate.h"
@@ -103,12 +102,12 @@ codegenIntegralType (TypeCLong   _) = [cty|long int|]
 codegenIntegralType (TypeCULong  _) = [cty|unsigned long int|]
 codegenIntegralType (TypeCLLong  _) = [cty|long long int|]
 codegenIntegralType (TypeCULLong _) = [cty|unsigned long long int|]
-#if SIZEOF_HSINT == 4
+#if   SIZEOF_HSINT == 4
 codegenIntegralType (TypeInt     _) = typename "int32_t"
 #elif SIZEOF_HSINT == 8
 codegenIntegralType (TypeInt     _) = typename "int64_t"
 #endif
-#if SIZEOF_HSINT == 4
+#if   SIZEOF_HSINT == 4
 codegenIntegralType (TypeWord    _) = typename "uint32_t"
 #elif SIZEOF_HSINT == 8
 codegenIntegralType (TypeWord    _) = typename "uint64_t"
@@ -121,8 +120,10 @@ codegenFloatingType (TypeDouble  _) = [cty|double|]
 codegenFloatingType (TypeCDouble _) = [cty|double|]
 
 codegenNonNumType :: NonNumType a -> C.Type
-codegenNonNumType (TypeBool   _) = error "codegenNonNum :: Bool"
-codegenNonNumType (TypeChar   _) = error "codegenNonNum :: Char"
+codegenNonNumType (TypeBool   _) = typename "uint8_t"
+#if   SIZEOF_HSCHAR == 4
+codegenNonNumType (TypeChar   _) = typename "int32_t"
+#endif
 codegenNonNumType (TypeCChar  _) = [cty|char|]
 codegenNonNumType (TypeCSChar _) = [cty|signed char|]
 codegenNonNumType (TypeCUChar _) = [cty|unsigned char|]
@@ -186,13 +187,11 @@ codegenFloatingTex (TypeDouble  _) = typename "TexDouble"
 codegenFloatingTex (TypeCDouble _) = typename "TexCDouble"
 
 
--- TLM 2010-06-29:
---   Bool and Char can be implemented once the array types in
---   Data.Array.Accelerate.[CUDA.]Array.Data are made concrete.
---
 codegenNonNumTex :: NonNumType a -> C.Type
-codegenNonNumTex (TypeBool   _) = error "codegenNonNumTex :: Bool"
-codegenNonNumTex (TypeChar   _) = error "codegenNonNumTex :: Char"
+codegenNonNumTex (TypeBool   _) = typename "TexWord8"
+#if   SIZEOF_HSCHAR == 4
+codegenNonNumTex (TypeChar   _) = typename "TexWord32"
+#endif
 codegenNonNumTex (TypeCChar  _) = typename "TexCChar"
 codegenNonNumTex (TypeCSChar _) = typename "TexCSChar"
 codegenNonNumTex (TypeCUChar _) = typename "TexCUChar"

diff --git a/Data/Array/Accelerate/CUDA/Compile.hs b/Data/Array/Accelerate/CUDA/Compile.hs
@@ -45,7 +45,6 @@ import Data.Label.PureM
 import Data.List
 import Data.Maybe
 import Data.Monoid
-import Foreign.Storable
 import System.Directory
 import System.Exit                                      ( ExitCode(..) )
 import System.FilePath

diff --git a/accelerate-cuda.cabal b/accelerate-cuda.cabal
@@ -9,9 +9,11 @@ Description:
   This library implements a backend for the Accelerate language instrumented for
   parallel execution on CUDA-capable NVIDIA GPUs.
   .
-  To use this backend you need CUDA version 3.x or later installed. Note that
-  currently there is no support for 'Char' and 'Bool' arrays (this is a
-  limitation of the front-end language).
+  To use this backend you need CUDA version 3.x or later installed, which you
+  can find at the NVIDIA Developer Zone.
+  .
+  <http://developer.nvidia.com/cuda-downloads>
+  .
 
 License:                BSD3
 License-file:           LICENSE