diff --git a/Data/Array/Accelerate/Language.hs b/Data/Array/Accelerate/Language.hs index 455477d42..efdc801b6 100644 --- a/Data/Array/Accelerate/Language.hs +++ b/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 diff --git a/Data/Array/Accelerate/Prelude.hs b/Data/Array/Accelerate/Prelude.hs index d9c49539a..2d11d1819 100644 --- a/Data/Array/Accelerate/Prelude.hs +++ b/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 -- ------------------- diff --git a/Data/Array/Accelerate/Pretty/HTML.hs b/Data/Array/Accelerate/Pretty/HTML.hs index e0cd6642b..b2268bafd 100644 --- a/Data/Array/Accelerate/Pretty/HTML.hs +++ b/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 diff --git a/accelerate.cabal b/accelerate.cabal index 9da403281..3d457c272 100644 --- a/accelerate.cabal +++ b/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