linear-accelerate (empty) → 0.1

raw patch · 9 files changed

+518/−0 lines, 9 filesdep +acceleratedep +basedep +lensbuild-type:Customsetup-changed

Dependencies added: accelerate, base, lens, linear

Files

• .travis.yml +26/−0
• .vim.custom +21/−0
• CHANGELOG.markdown +4/−0
• LICENSE +30/−0
• README.markdown +13/−0
• Setup.lhs +44/−0
• linear-accelerate.cabal +38/−0
• src/Linear/Accelerate.hs +326/−0
• travis/config +16/−0

@@ -0,0 +1,26 @@+language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update++  # Try installing some of the build-deps with apt-get for speed.+  - travis/cabal-apt-install $mode++install:+  - cabal configure $mode+  - cabal build++script:+  - $script+  - hlint src --cpp-define HLINT++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313linear-accelerate\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test"

@@ -0,0 +1,21 @@+" Add the following to your .vimrc to automatically load this on startup+" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++syntax on+set tags=TAGS;/+set listchars=tab:‗‗,trail:‗+set list++map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"

@@ -0,0 +1,4 @@+0.1+---+* Repository initialized+

@@ -0,0 +1,30 @@+Copyright 2014 Edward Kmett, Charles Durham++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,+STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN+ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE+POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,13 @@+linear-accelerate+=================++This package provides orphan instances that allows you to use `linear` vector spaces on `accelerate` backends++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the `#haskell` or `#haskell-lens` IRC channels on `irc.freenode.net`.++-Edward Kmett

@@ -0,0 +1,44 @@+#!/usr/bin/runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), fromFlag )+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Verbosity ( Verbosity )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  }++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}

@@ -0,0 +1,38 @@+name:          linear-accelerate+category:      Math, Algebra, Compilers/Interpreters, Concurrency, Data, Parallelism+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett, Charles Durham+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/linear-accelerate/+bug-reports:   http://github.com/ekmett/linear-accelerate/issues+copyright:     Copyright (C) 2014 Edward A. Kmett+synopsis:      Instances to use linear vector spaces on accelerate backends+description:   Instances to use linear vector spaces on accelerate backends+build-type:    Custom+extra-source-files:+  .travis.yml+  .vim.custom+  travis/config+  CHANGELOG.markdown+  README.markdown++source-repository head+  type: git+  location: git://github.com/ekmett/linear-accelerate.git++library+  build-depends:+    accelerate           >= 0.14  && < 0.15,+    base                 >= 4.5   && < 5,+    lens                 >= 4     && < 5,+    linear               >= 1.10  && < 2++  exposed-modules:+    Linear.Accelerate++  ghc-options: -Wall -fwarn-tabs -O2+  hs-source-dirs: src

@@ -0,0 +1,326 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Linear.Accelerate () where++import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Tuple+import Data.Array.Accelerate.Array.Sugar+import Data.Complex+import qualified Data.Foldable as F+import Linear+--import Linear.Plucker (Plucker(..))++--------------------------------------------------------------------------------+-- * V0+--------------------------------------------------------------------------------++type instance EltRepr (V0 a)  = ()+type instance EltRepr' (V0 a) = ()++instance Elt a => Elt (V0 a) where+  eltType _ = eltType ()+  toElt () = V0+  fromElt V0 = ()++  eltType' _ = eltType' ()+  toElt' () = V0+  fromElt' V0 = ()++instance IsTuple (V0 a) where+  type TupleRepr (V0 a) = ()+  fromTuple V0 = ()+  toTuple () = V0++instance Lift Exp (V0 a) where+  type Plain (V0 a) = ()+  lift V0 = Exp (Tuple NilTup)++instance Unlift Exp (V0 a) where+  unlift _ = V0++--------------------------------------------------------------------------------+-- * V1+--------------------------------------------------------------------------------++type instance EltRepr (V1 a) = EltRepr a+type instance EltRepr' (V1 a) = EltRepr' a++instance Elt a => Elt (V1 a) where+  eltType _ = eltType (undefined :: a)+  toElt = V1 . toElt+  fromElt (V1 a) = fromElt a++  eltType' _ = eltType' (undefined :: a)+  toElt' = V1 . toElt'+  fromElt' (V1 a) = fromElt' a++instance IsTuple (V1 a) where+  type TupleRepr (V1 a) = ((), a)+  fromTuple (V1 x) = ((), x)+  toTuple ((), x) = V1 x++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V1 a) where+  type Plain (V1 a) = V1 (Plain a)+  lift (V1 x) = Exp . Tuple $ NilTup `SnocTup` lift x++instance (Elt a, e ~ Exp a) => Unlift Exp (V1 e) where+  unlift t = V1 $ Exp $ ZeroTupIdx `Prj` t++--------------------------------------------------------------------------------+-- * V2+--------------------------------------------------------------------------------++type instance EltRepr (V2 a)  = EltRepr (a, a)+type instance EltRepr' (V2 a) = EltRepr' (a, a)++instance Elt a => Elt (V2 a) where+  eltType _ = eltType (undefined :: (a,a))+  toElt p = case toElt p of+     (x, y) -> V2 x y+  fromElt (V2 x y) = fromElt (x, y)++  eltType' _ = eltType' (undefined :: (a,a))+  toElt' p = case toElt' p of+     (x, y) -> V2 x y+  fromElt' (V2 x y) = fromElt' (x, y)++instance IsTuple (V2 a) where+  type TupleRepr (V2 a) = TupleRepr (a,a)+  fromTuple (V2 x y) = fromTuple (x,y)+  toTuple t = case toTuple t of+     (x, y) -> V2 x y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V2 a) where+  type Plain (V2 a) = V2 (Plain a)+  --lift = Exp . Tuple . F.foldl SnocTup NilTup+  lift (V2 x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (V2 e) where+  unlift t = V2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+                (Exp $ ZeroTupIdx `Prj` t)++--------------------------------------------------------------------------------+-- * V3+--------------------------------------------------------------------------------++type instance EltRepr (V3 a)  = EltRepr (a, a, a)+type instance EltRepr' (V3 a) = EltRepr' (a, a, a)++instance Elt a => Elt (V3 a) where+  eltType _ = eltType (undefined :: (a,a,a))+  toElt p = case toElt p of+     (x, y, z) -> V3 x y z+  fromElt (V3 x y z) = fromElt (x, y, z)++  eltType' _ = eltType' (undefined :: (a,a,a))+  toElt' p = case toElt' p of+     (x, y, z) -> V3 x y z+  fromElt' (V3 x y z) = fromElt' (x, y, z)++instance IsTuple (V3 a) where+  type TupleRepr (V3 a) = TupleRepr (a,a,a)+  fromTuple (V3 x y z) = fromTuple (x,y,z)+  toTuple t = case toTuple t of+     (x, y, z) -> V3 x y z++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V3 a) where+  type Plain (V3 a) = V3 (Plain a)+  --lift = Exp . Tuple . F.foldl SnocTup NilTup+  lift (V3 x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance (Elt a, e ~ Exp a) => Unlift Exp (V3 e) where+  unlift t = V3 (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+                (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+                (Exp $ ZeroTupIdx `Prj` t)++type instance ArrRepr (V3 a) = ArrRepr (Vector a)+type instance ArrRepr' (V3 a) = ArrRepr' (Vector a)++instance Elt a => Arrays (V3 a) where+  arrays _  = arrays (undefined :: Vector a)+  toArr ((), arr) = toArr' arr+  fromArr = (,) () . fromArr'++  arrays' _ = arrays' (undefined :: Vector a)+  toArr' arr = case toList arr of+    [a,b,c] -> V3 a b c+    _       -> error "shape mismatch"+  fromArr' = fromList (Z :. 3) . F.toList++-- $liftAcc+--+-- In theory we could support lifting these to 'Acc' array types as well, however+-- since the class associated type for that ignores one of its arguments, this requires+--+-- @+-- type 'Plain' ('V3' a) = 'Vector' a+-- @+--+-- while in order to instantiate the @'Lift' 'Exp` (V3 a)@ above we need+--+-- @+-- type 'Plain' ('V3' a) = V3 ('Plain' a)+-- @+--+-- so due to limitations in the accelerate API, we can't support both!++{-+instance Elt a => Lift Acc (V3 a) where+  type Plain (V3 a) = Vector a+  lift = lift . toArr'+-}++--------------------------------------------------------------------------------+-- * V4+--------------------------------------------------------------------------------++type instance EltRepr (V4 a)  = EltRepr (a, a, a, a)+type instance EltRepr' (V4 a) = EltRepr' (a, a, a, a)++instance Elt a => Elt (V4 a) where+  eltType _ = eltType (undefined :: (a,a,a,a))+  toElt p = case toElt p of+     (x, y, z, w) -> V4 x y z w+  fromElt (V4 x y z w) = fromElt (x, y, z, w)++  eltType' _ = eltType' (undefined :: (a,a,a,a))+  toElt' p = case toElt' p of+     (x, y, z, w) -> V4 x y z w+  fromElt' (V4 x y z w) = fromElt' (x, y, z, w)++instance IsTuple (V4 a) where+  type TupleRepr (V4 a) = TupleRepr (a,a,a,a)+  fromTuple (V4 x y z w) = fromTuple (x,y,z,w)+  toTuple t = case toTuple t of+     (x, y, z, w) -> V4 x y z w++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V4 a) where+  type Plain (V4 a) = V4 (Plain a)+  --  lift = Exp . Tuple . F.foldl SnocTup NilTup+  lift (V4 x y z w) = Exp $ Tuple $ NilTup `SnocTup`+                      lift x `SnocTup`+                      lift y `SnocTup`+                      lift z `SnocTup`+                      lift w++instance (Elt a, e ~ Exp a) => Unlift Exp (V4 e) where+  unlift t = V4 (Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` t)+                (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+                (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+                (Exp $ ZeroTupIdx `Prj` t)++--------------------------------------------------------------------------------+-- * Complex+--------------------------------------------------------------------------------++type instance EltRepr (Complex a)  = EltRepr (a, a)+type instance EltRepr' (Complex a) = EltRepr' (a, a)++instance Elt a => Elt (Complex a) where+  eltType _ = eltType (undefined :: (a,a))+  toElt p = case toElt p of+     (x, y) -> x :+ y+  fromElt (x :+ y) = fromElt (x, y)++  eltType' _ = eltType' (undefined :: (a,a))+  toElt' p = case toElt' p of+     (x, y) -> x :+ y+  fromElt' (x :+ y) = fromElt' (x, y)++instance IsTuple (Complex a) where+  type TupleRepr (Complex a) = TupleRepr (a,a)+  fromTuple (x :+ y) = fromTuple (x,y)+  toTuple t = case toTuple t of+     (x, y) -> x :+ y++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Complex a) where+  type Plain (Complex a) = Complex (Plain a)+--  lift = Exp . Tuple . F.foldl SnocTup NilTup+  lift (x :+ y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance (Elt a, e ~ Exp a) => Unlift Exp (Complex e) where+  unlift t = (Exp $ SuccTupIdx ZeroTupIdx `Prj` t) :+ (Exp $ ZeroTupIdx `Prj` t)++--------------------------------------------------------------------------------+-- * Quaternion+--------------------------------------------------------------------------------++type instance EltRepr (Quaternion a)  = EltRepr (a, a, a, a)+type instance EltRepr' (Quaternion a) = EltRepr' (a, a, a, a)++instance Elt a => Elt (Quaternion a) where+  eltType _ = eltType (undefined :: (a,a,a,a))+  toElt p = case toElt p of+     (x, y, z, w) -> Quaternion x (V3 y z w)+  fromElt (Quaternion x (V3 y z w)) = fromElt (x, y, z, w)++  eltType' _ = eltType' (undefined :: (a,a,a,a))+  toElt' p = case toElt' p of+     (x, y, z, w) -> Quaternion x (V3 y z w)+  fromElt' (Quaternion x (V3 y z w)) = fromElt' (x, y, z, w)++instance IsTuple (Quaternion a) where+  type TupleRepr (Quaternion a) = TupleRepr (a,a,a,a)+  fromTuple (Quaternion x (V3 y z w)) = fromTuple (x,y,z,w)+  toTuple t = case toTuple t of+     (x, y, z, w) -> Quaternion x (V3 y z w)++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Quaternion a) where+  type Plain (Quaternion a) = Quaternion (Plain a)+  --lift = Exp . Tuple . F.foldl SnocTup NilTup+  lift (Quaternion x (V3 y z w)) = Exp $ Tuple $ NilTup `SnocTup`+                                   lift x `SnocTup`+                                   lift y `SnocTup`+                                   lift z `SnocTup`+                                   lift w++instance (Elt a, e ~ Exp a) => Unlift Exp (Quaternion e) where+  unlift t = Quaternion (Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` t)+                    (V3 (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+                        (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+                        (Exp $ ZeroTupIdx `Prj` t))++--------------------------------------------------------------------------------+-- * Plücker+--------------------------------------------------------------------------------+{-+type instance EltRepr (Plucker a)  = EltRepr (a, a, a, a, a, a)+type instance EltRepr' (Plucker a) = EltRepr' (a, a, a, a, a, a)++instance Elt a => Elt (Plucker a) where+  eltType _ = eltType (undefined :: (a,a,a,a,a,a))+  toElt p = case toElt p of+     (x, y, z, w, u, v) -> Plucker x y z w u v+  fromElt (Plucker x y z w u v) = fromElt (x, y, z, w, u, v)++  eltType' _ = eltType' (undefined :: (a,a,a,a,a,a))+  toElt' p = case toElt' p of+     (x, y, z, w, u, v) -> Plucker x y z w u v+  fromElt' (Plucker x y z w u v) = fromElt' (x, y, z, w, u, v)++instance IsTuple (Plucker a) where+  type TupleRepr (Plucker a) = TupleRepr (a,a,a,a)+  fromTuple (Plucker x y z w u v) = fromTuple (x, y, z, w, u, v)+  toTuple t = case toTuple t of+     (x, y, z, w, u, v) -> Plucker x y z w u v++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (Plucker a) where+  type Plain (Plucker a) = Plucker (Plain a)+  lift = Exp . Tuple . F.foldl SnocTup NilTup++instance (Elt a, e ~ Exp a) => Unlift Exp (Plucker e) where+  unlift t = Plucker+    (Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)))) `Prj` t)+    (Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx))) `Prj` t)+    (Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` t)+    (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+    (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+    (Exp $ ZeroTupIdx `Prj` t)+-}

@@ -0,0 +1,16 @@+-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix+--+-- This is particularly useful for travis-ci to get it to stop complaining+-- about a broken build when everything is still correct on our end.+--+-- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead+--+-- To enable this, uncomment the before_script in .travis.yml++remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive+remote-repo-cache: ~/.cabal/packages+world-file: ~/.cabal/world+build-summary: ~/.cabal/logs/build.log+remote-build-reporting: anonymous+install-dirs user+install-dirs global