Permalink
Browse files

Fixed a problem with mkPermute, with the added benefited of greater r…

…eadability of all skeletons
  • Loading branch information...
dybber committed Sep 1, 2011
1 parent e2ee1fb commit 9bef8265a8bfc608ead1785f6d1acc4e358d85d0
Showing with 37 additions and 41 deletions.
  1. +17 −23 Data/Array/Accelerate/OpenCL/CodeGen/Skeleton.hs
  2. +20 −18 Data/Array/Accelerate/OpenCL/CodeGen/Tuple.hs
@@ -117,21 +117,20 @@ import Data.Array.Accelerate.OpenCL.CodeGen.Monad
-- ---
mkMap :: [C.Type] -> [C.Type] -> C.Exp -> CUTranslSkel
mkMap tyOut tyIn_A apply = runCGM $ do
- Set set <- mkOutputTuple tyOut
- Get get <- mkInputTuple "A" tyIn_A
+ d_out <- mkOutputTuple tyOut
+ d_inA <- mkInputTuple "A" tyIn_A
mkApply 1 apply
ps <- getParams
addDefinitions
[cunit|
- __kernel void map (const int shape, $params:ps) {
- int idx;
- const int gridSize = get_global_size(0);
+ __kernel void map (const $ty:ix shape, $params:ps) {
+ const $ty:ix gridSize = get_global_size(0);
- for(idx = get_global_id(0); idx < shape; idx += gridSize) {
- $ty:(typename "TyInA") val = $exp:(get "idx") ;
+ for($ty:ix idx = get_global_id(0); idx < shape; idx += gridSize) {
+ $ty:(typename "TyInA") val = getA("idx", $args:d_inA) ;
$ty:outType new = apply(val) ;
- $exp:(set "idx" "new") ;
+ set("idx" "new", $args:d_out) ;
}
}
|]
@@ -141,9 +140,9 @@ mkZipWith :: ([C.Type], Int)
->([C.Type], Int) -> C.Exp -> CUTranslSkel
mkZipWith (tyOut,dimOut) (tyInB, dimInB) (tyInA, dimInA) apply =
runCGM $ do
- Set set <- mkOutputTuple tyOut
- Get getA <- mkInputTuple "A" tyInA
- Get getB <- mkInputTuple "B" tyInB
+ d_out <- mkOutputTuple tyOut
+ d_inA <- mkInputTuple "A" tyInA
+ d_inB <- mkInputTuple "B" tyInB
mkApply 2 apply
shape_out <- mkShape "DimOut" dimOut
@@ -164,10 +163,8 @@ mkZipWith (tyOut,dimOut) (tyInB, dimInB) (tyInA, dimInA) apply =
$ty:ix iA = $id:(toIndex dimInB)(shInB, $id:(fromIndex dimInB)(shOut, ix));
$ty:ix iB = $id:(toIndex dimInA)(shInA, $id:(fromIndex dimInA)(shOut, ix));
- $ty:(typename "TyInB") valB = $exp:(getB "iB") ;
- $ty:(typename "TyInA") valA = $exp:(getA "iA") ;
- $ty:outType new = apply(valB, valA) ;
- $exp:(set "ix" "new") ;
+ $ty:outType val = apply(getB("iB", $args:d_inB), getA("iA", $args:d_inA)) ;
+ set("ix" "val", $args:d_out) ;
}
}
|]
@@ -270,7 +267,7 @@ mkZipWith (tyOut,dimOut) (tyInB, dimInB) (tyInA, dimInA) apply =
mkPermute :: [C.Type] -> Int -> Int -> C.Exp -> C.Exp -> CUTranslSkel
mkPermute ty dimOut dimInA combinefn indexfn = runCGM $ do
- (Set set : Get get : _) <- mkTupleTypeAsc 2 ty
+ (d_out, d_inA : _) <- mkTupleTypeAsc 2 ty
shape_out <- mkShape "DimOut" dimOut
shape_inA <- mkShape "DimInA" dimInA
@@ -283,7 +280,7 @@ mkPermute ty dimOut dimInA combinefn indexfn = runCGM $ do
__kernel void permute (const $ty:shape_out shOut,
const $ty:shape_inA shInA,
$params:ps) {
- const $ty:ix shapeSize = $id:(size dimInA)(shIn0);
+ const $ty:ix shapeSize = $id:(size dimInA)(shInA);
const $ty:ix gridSize = get_global_size(0);
for ($ty:ix ix = get_global_id(0); ix < shapeSize; ix += gridSize) {
@@ -293,12 +290,9 @@ mkPermute ty dimOut dimInA combinefn indexfn = runCGM $ do
if (!ignore(dst)) {
$ty:ix j = $id:(toIndex dimOut)(shOut, dst);
- $ty:(typename "TyOut") valB = $exp:(get "j") ;
- $ty:(typename "TyInA") valA = $exp:(get "ix") ;
- $ty:outType new = apply(valB, valA) ;
- $exp:(set "j" "new") ;
-
- //set(d_out, j, apply(get0(d_in0, ix), get0(d_out, j)));
+ $ty:outType val = apply(getA("j", $args:d_out),
+ getA("ix", $args:d_inA)) ;
+ set("j" "val", $args:d_out) ;
}
}
}
@@ -11,7 +11,7 @@
module Data.Array.Accelerate.OpenCL.CodeGen.Tuple
(
- mkInputTuple, mkOutputTuple, Accessor (..),
+ mkInputTuple, mkOutputTuple, --Accessor (..),
mkTupleTypeAsc
-- mkTupleType, mkTuplePartition
)
@@ -31,16 +31,18 @@ import Control.Monad
import Data.Array.Accelerate.OpenCL.CodeGen.Util
-data Accessor = Get (String -> Exp)
- | Set (String -> String -> Exp)
+-- data Accessor = Get (String -> Exp)
+-- | Set (String -> String -> Exp)
-mkInputTuple :: String -> [Type]-> CGM Accessor
+type Arguments = [Exp]
+
+mkInputTuple :: String -> [Type]-> CGM Arguments
mkInputTuple subscript types = mkTupleType (Just subscript) types
-mkOutputTuple :: [Type]-> CGM Accessor
+mkOutputTuple :: [Type]-> CGM Arguments
mkOutputTuple types = mkTupleType Nothing types
-mkTupleType :: Maybe String -> [Type] -> CGM Accessor
+mkTupleType :: Maybe String -> [Type] -> CGM Arguments
mkTupleType subscript types = do
let n = length types
tuple_name = maybe "TyOut" ("TyIn" ++) subscript
@@ -50,27 +52,27 @@ mkTupleType subscript types = do
| otherwise = [tuple_name]
addDefinitions $ zipWith (mkTypedef volatile) tynames types
- accessorCall <- mkParameterList subscript n tynames
+ args <- mkParameterList subscript n tynames
(maybe mkSet mkGet subscript) n tynames
when (n > 1) $ addDefinition (mkStruct tuple_name volatile types)
- return accessorCall
+ return args
-mkTupleTypeAsc :: Int -> [Type] -> CGM [Accessor]
+mkTupleTypeAsc :: Int -> [Type] -> CGM (Arguments, [Arguments])
mkTupleTypeAsc n types = do
- accessorOut <- mkOutputTuple types
- accessorsIn <- mkInputTuples (n-1)
- return $ accessorOut : accessorsIn
+ argsOut <- mkOutputTuple types
+ argsIn <- mkInputTuples (n-1)
+ return $ (argsOut, argsIn)
where
mkInputTuples 0 = return []
mkInputTuples n = do
as <- mkInputTuples (n-1)
a <- mkInputTuple (show $ n-1) types
return $ a : as
-mkParameterList :: Maybe String -> Int -> [String] -> CGM Accessor
+mkParameterList :: Maybe String -> Int -> [String] -> CGM Arguments
mkParameterList subscript n tynames = do
addParams $ params (zip types' param_names)
- return accessorCall
+ return args
where
param_prefix = maybe "out" ("in" ++) subscript
param_names
@@ -79,10 +81,10 @@ mkParameterList subscript n tynames = do
types' = map (mkPtr . mkGlobal . typename) tynames
args = map (\p -> [cexp|$id:p|]) param_names
- accessorCall =
- case subscript of
- Nothing -> Set $ \idx val -> [cexp|set($id:idx, $id:val, $args:args)|]
- Just x -> Get $ \idx -> [cexp|$id:("get" ++ x)($id:idx, $args:args)|]
+ -- accessorCall =
+ -- case subscript of
+ -- Nothing -> Set $ \idx val -> [cexp|set($id:idx, $id:val, $args:args)|]
+ -- Just x -> Get $ \idx -> [cexp|$id:("get" ++ x)($id:idx, $args:args)|]
mkGet :: String -> Int -> [String] -> CGM ()
mkGet prj n tynames = do

0 comments on commit 9bef826

Please sign in to comment.