Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'master' of github.com:AccelerateHS/accelerate

  • Loading branch information...
commit e4fb255868b3eb946e879bbe486f02625b2ba5f2 2 parents eeb978b + 215a817
@rrnewton rrnewton authored
View
23 Data/Array/Accelerate/Language.hs
@@ -918,25 +918,30 @@ index0 = lift Z
-- |Turn an 'Int' expression into a rank-1 indexing expression.
--
-index1 :: (Elt i, IsIntegral i) => Exp i -> Exp DIM1
-index1 i = lift (Z :. fromIntegral i)
+index1 :: Elt i => Exp i -> Exp (Z :. i)
+index1 i = lift (Z :. i)
-- |Turn a rank-1 indexing expression into an 'Int' expression.
--
-unindex1 :: (Elt i, IsIntegral i) => Exp DIM1 -> Exp i
-unindex1 ix = let Z :. i = unlift ix in fromIntegral i
+unindex1 :: Elt i => Exp (Z :. i) -> Exp i
+unindex1 ix = let Z :. i = unlift ix in i
-- | Creates a rank-2 index from two Exp Int`s
--
-index2 :: (Elt i, IsIntegral i) => Exp i -> Exp i -> Exp DIM2
-index2 i j = lift (Z :. fromIntegral i :. fromIntegral j)
+index2 :: (Elt i, Slice (Z :. i))
+ => Exp i
+ -> Exp i
+ -> Exp (Z :. i :. i)
+index2 i j = lift (Z :. i :. j)
-- | Destructs a rank-2 index to an Exp tuple of two Int`s.
--
-unindex2 :: (Elt i, IsIntegral i) => Exp DIM2 -> Exp (i, i)
+unindex2 :: forall i. (Elt i, Slice (Z :. i))
+ => Exp (Z :. i :. i)
+ -> Exp (i, i)
unindex2 ix
- = let Z :. i :. j = unlift ix :: Z :. Exp Int :. Exp Int
- in lift (fromIntegral i, fromIntegral j)
+ = let Z :. i :. j = unlift ix :: Z :. Exp i :. Exp i
+ in lift (i, j)
-- Conditional expressions
View
43 Data/Array/Accelerate/Prelude.hs
@@ -334,7 +334,7 @@ scanlSeg f z vec seg = scanl1Seg f vec' seg'
seg' = map (+1) seg
vec' = permute const
(fill (index1 $ size vec + size seg) z)
- (\ix -> index1 $ unindex1 ix + inc ! ix)
+ (\ix -> index1' $ unindex1' ix + inc ! ix)
vec
-- Each element in the segments must be shifted to the right one additional
@@ -381,7 +381,7 @@ scanl'Seg f z vec seg = result
--
seg' = map (+1) seg
tails = zipWith (+) seg . P.fst $ scanl' (+) 0 seg'
- sums = backpermute (shape seg) (\ix -> index1 $ tails ! ix) vec'
+ sums = backpermute (shape seg) (\ix -> index1' $ tails ! ix) vec'
-- Slice out the body of each segment.
--
@@ -394,11 +394,11 @@ scanl'Seg f z vec seg = result
offset = scanl1 (+) seg
inc = scanl1 (+)
$ permute (+) (fill (index1 $ size vec + 1) 0)
- (\ix -> index1 $ offset ! ix)
+ (\ix -> index1' $ offset ! ix)
(fill (shape seg) (1 :: Exp i))
body = backpermute (shape vec)
- (\ix -> index1 $ unindex1 ix + inc ! ix)
+ (\ix -> index1' $ unindex1' ix + inc ! ix)
vec'
@@ -458,7 +458,7 @@ scanrSeg f z vec seg = scanr1Seg f vec' seg'
seg' = map (+1) seg
vec' = permute const
(fill (index1 $ size vec + size seg) z)
- (\ix -> index1 $ unindex1 ix + inc ! ix - 1)
+ (\ix -> index1' $ unindex1' ix + inc ! ix - 1)
vec
@@ -480,12 +480,12 @@ scanr'Seg f z vec seg = result
-- reduction values
seg' = map (+1) seg
heads = P.fst $ scanl' (+) 0 seg'
- sums = backpermute (shape seg) (\ix -> index1 $ heads ! ix) vec'
+ sums = backpermute (shape seg) (\ix -> index1' $ heads ! ix) vec'
-- body segments
inc = scanl1 (+) $ mkHeadFlags seg
body = backpermute (shape vec)
- (\ix -> index1 $ unindex1 ix + inc ! ix)
+ (\ix -> index1' $ unindex1' ix + inc ! ix)
vec'
@@ -541,11 +541,11 @@ postscanrSeg f e vec seg
mkHeadFlags :: (Elt i, IsIntegral i) => Acc (Segments i) -> Acc (Segments i)
mkHeadFlags seg
= init
- $ permute (+) zeros (\ix -> index1 (offset ! ix)) ones
+ $ permute (+) zeros (\ix -> index1' (offset ! ix)) ones
where
(offset, len) = scanl' (+) 0 seg
- zeros = fill (index1 $ the len + 1) 0
- ones = fill (index1 $ size offset) 1
+ zeros = fill (index1' $ the len + 1) 0
+ ones = fill (index1 $ size offset) 1
-- |Compute tail flags vector from segment vector for right-scans. That is, the
-- flag is placed at the last place in each segment.
@@ -553,11 +553,11 @@ mkHeadFlags seg
mkTailFlags :: (Elt i, IsIntegral i) => Acc (Segments i) -> Acc (Segments i)
mkTailFlags seg
= init
- $ permute (+) zeros (\ix -> index1 (the len - 1 - offset ! ix)) ones
+ $ permute (+) zeros (\ix -> index1' (the len - 1 - offset ! ix)) ones
where
(offset, len) = scanr' (+) 0 seg
- zeros = fill (index1 $ the len + 1) 0
- ones = fill (index1 $ size offset) 1
+ zeros = fill (index1' $ the len + 1) 0
+ ones = fill (index1 $ size offset) 1
-- |Construct a segmented version of a function from a non-segmented version.
-- The segmented apply operates on a head-flag value tuple, and follows the
@@ -572,6 +572,23 @@ segmented f a b =
in
lift (aF .|. bF, bF /=* 0 ? (bV, f aV bV))
+-- |Index construction and destruction generalised to integral types.
+--
+-- We generalise the segment descriptor to integral types because some
+-- architectures, such as GPUs, have poor performance for 64-bit types. So,
+-- there is a tension between performance and requiring 64-bit indices for some
+-- applications, and we would not like to restrict ourselves to either one.
+--
+-- As we don't yet support non-Int dimensions in shapes, we will need to convert
+-- back to concrete Int. However, don't put these generalised forms into the
+-- base library, because it results in too many ambiguity errors.
+--
+index1' :: (Elt i, IsIntegral i) => Exp i -> Exp DIM1
+index1' i = lift (Z :. fromIntegral i)
+
+unindex1' :: (Elt i, IsIntegral i) => Exp DIM1 -> Exp i
+unindex1' ix = let Z :. i = unlift ix in fromIntegral i
+
-- Reshaping of arrays
-- -------------------
View
38 Data/Array/Accelerate/Pretty/HTML.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, NoMonomorphismRestriction #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-- |
-- Module : Data.Array.Accelerate.Pretty.HTML
-- Copyright : [2010..2011] Sean Seefried
@@ -20,15 +22,15 @@ module Data.Array.Accelerate.Pretty.HTML (
-- standard libraries
import Data.String
import Data.Monoid
-import qualified Data.Text as T
-import Text.Blaze.Renderer.Utf8
-import Text.Blaze.Html4.Transitional ((!))
-import qualified Text.Blaze.Html4.Transitional as H
-import qualified Text.Blaze.Html4.Transitional.Attributes as A
+import Text.Blaze.Html.Renderer.Utf8
+import Text.Blaze.Html4.Transitional ( (!) )
+import qualified Data.Text as T
+import qualified Text.Blaze.Html4.Transitional as H
+import qualified Text.Blaze.Html4.Transitional.Attributes as A
-import System.IO
-import System.IO.Error hiding (catch)
-import qualified Data.ByteString.Lazy as BS
+import System.IO.Error
+import Control.Exception
+import qualified Data.ByteString.Lazy as BS
-- friends
import Data.Array.Accelerate.AST
@@ -38,12 +40,12 @@ combineHtml :: String -> String -> [H.Html] -> H.Html
combineHtml cssClass label nodes = do
let inner = foldl (>>) (return ()) nodes
H.div ! A.class_ ("node " `mappend` fromString cssClass `mappend` " expanded") $ do
- H.span ! A.class_ "selector" $ H.text (fromString label)
+ H.span ! A.class_ "selector" $ H.toMarkup label
inner
leafHtml :: String -> String -> H.Html
leafHtml cssClass label =
H.div ! A.class_ ("node " `mappend` fromString cssClass `mappend` " leaf") $
- H.span $ H.text (fromString label)
+ H.span $ H.toMarkup label
htmlLabels :: Labels
htmlLabels = Labels { accFormat = "array-node"
@@ -68,7 +70,7 @@ htmlAST acc = H.docTypeHtml $
H.script ! A.type_ "text/javascript" !
A.src "https://ajax.googleapis.com/ajax/libs/jquery/1.4.4/jquery.min.js" $ mempty
H.link ! A.rel "stylesheet" ! A.href "accelerate.css" ! A.type_ "text/css"
- H.script ! A.type_ "text/javascript" $ H.text $
+ H.script ! A.type_ "text/javascript" $ H.toMarkup $
T.unlines ["function collapse() {"
," var parent=$(this).parent();"
," var that = $(this);"
@@ -177,15 +179,13 @@ dumpHtmlAST basename acc =
where
writeHtmlFile = do
let cssPath = "accelerate.css"
- h <- openFile cssPath WriteMode
- hPutStr h accelerateCSS
- hClose h
- let path = basename ++ ".html"
- h <- openFile path WriteMode
- BS.hPutStr h (renderHtml $ htmlAST acc)
+ let path = basename ++ ".html"
+ --
+ writeFile cssPath accelerateCSS
+ BS.writeFile path (renderHtml $ htmlAST acc)
putStrLn ("HTML file successfully written to `" ++ path ++ "'\n" ++
"CSS file written to `" ++ cssPath ++ "'")
- hClose h
+
handler :: IOError -> IO ()
handler e =
case True of
View
15 accelerate.cabal
@@ -92,14 +92,19 @@ Library
Include-Dirs: include
Build-depends: array >= 0.3 && < 0.5,
base == 4.*,
- containers >= 0.3 && < 0.5,
- ghc-prim == 0.2.*,
+ containers >= 0.3 && < 0.6,
+ ghc-prim >= 0.2 && < 0.4,
pretty >= 1.0 && < 1.2
if flag(more-pp)
- Build-depends: bytestring == 0.9.*,
- blaze-html == 0.3.*,
- text == 0.10.*
+ 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
Data.Array.Accelerate.AST
Please sign in to comment.
Something went wrong with that request. Please try again.