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

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

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,23 +541,23 @@ 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.
 --
 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
 -- -------------------

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

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