https://github.com/AccelerateHS/accelerate/issues/375

accelerate-issue375.cabal

name:                accelerate-issue375
version:             0.1.0.0
build-type:          Simple
cabal-version:       >=1.10

library
  exposed-modules:     Issue375
  other-extensions:    FlexibleContexts, ScopedTypeVariables, TypeFamilies, ViewPatterns
  build-depends:
      base >=4.9 && <4.10
    , accelerate
    , accelerate-llvm-ptx
    , linear-accelerate
    , linear
    , lens-accelerate
  default-language:    Haskell2010

cabal.project

packages:
  ./

constraints:
    accelerate == 1.0.0.0
  , accelerate-llvm == 1.0.0.0
  , accelerate-llvm-native == 1.0.0.0
  , accelerate-llvm-ptx == 1.0.0.0
  , chaselev-deque == 0.5.0.5
  , cuda == 0.7.5.3
  , lens-accelerate == 0.1.0.0
  , libffi == 0.1
  , linear-accelerate == 0.3
  , llvm-hs == 4.0.1.0
  , llvm-hs-pure == 4.0.0.0
  , nvvm == 0.7.5.2
  , unique == 0

package accelerate
  flags: -unsafe-checks +bounds-checks +debug -ekg -internal-checks

package accelerate-llvm
  flags: +debug +chase-lev

package accelerate-llvm-native
  flags: +debug

package accelerate-llvm-ptx
  flags: +debug -nvvm

package llvm-hs
  flags: +shared-llvm

Issue375.hs

{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}
module Issue375 where

import Data.Array.Accelerate                                as A
import Data.Array.Accelerate.Debug                          as A
import Data.Array.Accelerate.Control.Lens
import Data.Array.Accelerate.Linear
import Data.Functor
import qualified Linear                                     as L
import qualified Prelude                                    as P

-- import Data.Array.Accelerate.Interpreter
-- import Data.Array.Accelerate.LLVM.Native
import Data.Array.Accelerate.LLVM.PTX

type Matrix a = Array DIM2 a

singleton :: Elt a => a -> Scalar a
singleton x = fromList Z [x]

multiplyMatrix4Vector ::
   forall a f. (A.Elt a, P.Num (Exp a), Functor f, Box f a, Additive f, A.Elt (f a)) =>
   Acc (Matrix (f a)) ->
   Acc (Vector a) ->
   Acc (Vector (f a))
multiplyMatrix4Vector m v =
    A.fold1 (^+^) $
    (A.zipWith (\v' s' -> s' *^ v') m
       (A.replicate (A.lift $ Any :. rows :. All) v) :: Acc (Matrix (f a)))
  where
    Z :. (rows :: Exp Int) :. (_cols :: Exp Int) = unlift (shape m)

foo :: ([Double], [Double], [Double])
foo = (A.toList dCArr, P.map (view L._x) (A.toList outMat :: [V4 Double]), A.toList outVec)
  where
    n  = 1
    xs = [27000]
    (dCArr, outMat :: Matrix (V4 Double), outVec) =
        run1 code ( A.fromList (Z :. P.length xs) xs, singleton n)
    code :: Acc ( A.Vector Double, A.Scalar Int)
         -> Acc ( A.Vector Double, Matrix (V4 Double), A.Vector Double)
    code (unlift -> (xs, (the -> n))) = out
      where
        out :: Acc (A.Vector Double, Matrix (V4 Double), A.Vector Double)
        out = A.lift
            ( dC -- A.fromList (Z :. 0) []
            , phiMat -- A.fromList (Z :. 0 :. 0) []
            , uPut -- A.fromList (Z :. 0) []
            )
        dC = A.map (view _x) $
            multiplyMatrix4Vector phiMat uPut
        phiMat = A.generate (A.index2 (A.length xs) n) $
            \_ -> A.lift (V4 0 0 0 0 :: V4 (Exp Double))
        uPut = A.generate (lift $ Z :. n) $ \_ -> 0

Setup.hs

import Distribution.Simple
main = defaultMain

stack.yaml

# For more information, see: https://github.com/commercialhaskell/stack/blob/release/doc/yaml_configuration.md
# vim: nospell

resolver: lts-8.0

packages:
- .
# - location:
#     git:    https://github.com/ekmett/linear-accelerate.git
#     commit: c44d7c48aad21be2865d71fd9b71b53487a63568

extra-deps:
- 'accelerate-1.0.0.0'
- 'accelerate-llvm-1.0.0.0'
- 'accelerate-llvm-native-1.0.0.0'
- 'accelerate-llvm-ptx-1.0.0.0'
- 'chaselev-deque-0.5.0.5'
- 'cuda-0.7.5.3'
- 'lens-accelerate-0.1.0.0'
- 'libffi-0.1'
- 'linear-accelerate-0.3'
- 'llvm-hs-4.0.1.0'
- 'llvm-hs-pure-4.0.0.0'
- 'nvvm-0.7.5.2'
- 'unique-0'

# Override default flag values for local packages and extra-deps
flags:
  accelerate:
    unsafe-checks: false
    bounds-checks: true
    debug: true
    ekg: false
    internal-checks: false
  accelerate-llvm:
    debug: true
    chase-lev: true
  accelerate-llvm-native:
    debug: true
  accelerate-llvm-ptx:
    debug: true
    nvvm: false
  llvm-hs:
    shared-llvm: true

# Extra package databases containing global packages
extra-package-dbs: []

# Control whether we use the GHC we find on the path
# system-ghc: true

# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: >= 0.1.4.0

# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64

# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]