Last active
April 14, 2017 04:06
-
-
Save tmcdonell/e4ef72ae43d8695df852febc3b01e819 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE ViewPatterns #-} | |
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 | |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# 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] | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment