packages feed

linear-accelerate 0.2 → 0.3

raw patch · 19 files changed

+1786/−333 lines, 19 filesdep +distributivedep ~acceleratenew-uploader

Dependencies added: distributive

Dependency ranges changed: accelerate

Files

.travis.yml view
@@ -1,19 +1,76 @@-language: haskell-before_install:-  # Uncomment whenever hackage is down.-  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+# vim: nospell+#+# Basic template to test with GHC=[7.8, 7.10, 8.0]. Caches the 'stack' build+# directory to speed subsequent compilations.+#+language: generic+dist: precise -  # Try installing some of the build-deps with apt-get for speed.-  - travis/cabal-apt-install $mode+cache:+  directories:+    - $HOME/.stack+    - .stack-work/install +addons:+  apt:+    sources: &apt_sources+      - hvr-ghc+      - ubuntu-toolchain-r-test+    packages: &apt_packages+      - libgmp-dev+      - happy-1.19.5+      - alex-3.1.7++matrix:+  include:+    - env: GHC=7.8.4 CABAL=1.18+      compiler: "GHC 7.8"+      addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, cabal-install-1.18 ] }}++    - env: GHC=7.10.3 CABAL=1.22+      compiler: "GHC 7.10"+      addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, cabal-install-1.22 ] }}++    - env: GHC=8.0.2 CABAL=1.24+      compiler: "GHC 8.0"+      addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, cabal-install-1.24 ] }}++    # - env: GHC=head CABAL=head+    #   compiler: "GHC HEAD"+    #   addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, ghc-head, cabal-install-head ] }}++  # allow_failures:+  #   - env: GHC=head CABAL=head++  fast_finish: true++before_install:+  - export PATH=/opt/cabal/$CABAL/bin:/opt/alex/3.1.7/bin:/opt/happy/1.19.5/bin:$HOME/.cabal/bin:$PATH+  - source .travis/install-stack.sh+ install:-  - cabal configure $mode-  - cabal build+  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"+  - cabal --version+  - stack --version+  - |+      if [ ${GHC} == head -o ! -e stack.yaml ]; then+        travis_retry cabal install --only-dependencies+      else+        travis_retry stack build --only-dependencies --no-terminal --no-haddock-deps+      fi  script:-  - $script-  - hlint src --cpp-define HLINT+  - |+      if [ ${GHC} == head -o ! -e stack.yaml ]; then+        cabal install+        cabal haddock+      else+        stack build --no-terminal --haddock --no-haddock-deps+      fi +after_success:+  - source .travis/update-accelerate-buildbot.sh+ notifications:   irc:     channels:@@ -22,5 +79,3 @@     template:       - "\x0313linear-accelerate\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" -env:-  - mode="--enable-tests" script="cabal test"
README.markdown view
@@ -1,7 +1,7 @@ linear-accelerate ================= -This package provides orphan instances that allows you to use `linear` vector spaces on `accelerate` backends+This package provides orphan instances that allows you to use `linear` vector spaces in `accelerate`.  Contact Information -------------------
linear-accelerate.cabal view
@@ -1,22 +1,21 @@ name:          linear-accelerate category:      Math, Algebra, Compilers/Interpreters, Concurrency, Data, Parallelism-version:       0.2+version:       0.3 license:       BSD3 cabal-version: >= 1.8 license-file:  LICENSE-author:        Edward A. Kmett, Charles Durham+author:        Edward A. Kmett, Charles Durham, Trevor L. McDonell 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+synopsis:      Lifting linear vector spaces into Accelerate+description:   Lifting linear vector spaces into Accelerate build-type:    Custom extra-source-files:   .travis.yml   .vim.custom-  travis/config   CHANGELOG.markdown   README.markdown @@ -24,15 +23,43 @@   type: git   location: git://github.com/ekmett/linear-accelerate.git +source-repository this+  type: git+  tag: v0.3+  location: git://github.com/ekmett/linear-accelerate.git++custom-setup+  setup-depends:+      base              >= 4.5+    , Cabal             >= 1.18+    , filepath          >= 1.0+ library   build-depends:-    accelerate           >= 0.15  && < 0.16,-    base                 >= 4.5   && < 5,-    lens                 >= 4     && < 5,-    linear               >= 1.10  && < 2+      base              >= 4.5          && < 5+    , accelerate        >= 0.16+    , distributive      >= 0.2.2        && < 1+    , lens              >= 4            && < 5+    , linear            >= 1.10         && < 2    exposed-modules:-    Linear.Accelerate+    Data.Array.Accelerate.Linear+    Data.Array.Accelerate.Linear.Epsilon+    Data.Array.Accelerate.Linear.Matrix+    Data.Array.Accelerate.Linear.Metric+    Data.Array.Accelerate.Linear.Plucker+    Data.Array.Accelerate.Linear.Quaternion+    Data.Array.Accelerate.Linear.Type+    Data.Array.Accelerate.Linear.V0+    Data.Array.Accelerate.Linear.V1+    Data.Array.Accelerate.Linear.V2+    Data.Array.Accelerate.Linear.V3+    Data.Array.Accelerate.Linear.V4+    Data.Array.Accelerate.Linear.Vector +  other-modules:+    Data.Array.Accelerate.Linear.Lift+   ghc-options: -Wall -fwarn-tabs -O2   hs-source-dirs: src+
+ src/Data/Array/Accelerate/Linear.hs view
@@ -0,0 +1,45 @@+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- This module simply re-exports everything from the various modules+-- that make up the linear package, lifted to Accelerate.+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear (++  module Data.Array.Accelerate.Linear.Type,+  module Data.Array.Accelerate.Linear.Epsilon,+  module Data.Array.Accelerate.Linear.Matrix,+  module Data.Array.Accelerate.Linear.Metric,+  module Data.Array.Accelerate.Linear.Plucker,+  module Data.Array.Accelerate.Linear.Quaternion,+  module Data.Array.Accelerate.Linear.V0,+  module Data.Array.Accelerate.Linear.V1,+  module Data.Array.Accelerate.Linear.V2,+  module Data.Array.Accelerate.Linear.V3,+  module Data.Array.Accelerate.Linear.V4,+  module Data.Array.Accelerate.Linear.Vector,++) where++import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.Epsilon+import Data.Array.Accelerate.Linear.Matrix+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Plucker+import Data.Array.Accelerate.Linear.Quaternion+import Data.Array.Accelerate.Linear.V0+import Data.Array.Accelerate.Linear.V1+import Data.Array.Accelerate.Linear.V2+import Data.Array.Accelerate.Linear.V3+import Data.Array.Accelerate.Linear.V4+import Data.Array.Accelerate.Linear.Vector+
+ src/Data/Array/Accelerate/Linear/Epsilon.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE ConstraintKinds   #-}+{-# LANGUAGE FlexibleContexts  #-}+{-# LANGUAGE NoImplicitPrelude #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Epsilon+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Free metric spaces+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Epsilon+  where++import Data.Array.Accelerate+++-- | Provides a fairly subjective test to see if a quantity is near zero.+--+-- >>> nearZero (1e-11 :: Double)+-- False+--+-- >>> nearZero (1e-17 :: Double)+-- True+--+-- >>> nearZero (1e-5 :: Float)+-- False+--+-- >>> nearZero (1e-7 :: Float)+-- True+--+class Num a => Epsilon a where+  -- | Determine if a quantity is near zero.+  nearZero :: Exp a -> Exp Bool++-- | @'abs' a '<=' 1e-6@+--+instance Epsilon Float where+  nearZero a = abs a <= 1.0e-6++-- | @'abs' a '<=' 1e-12@+--+instance Epsilon Double where+  nearZero a = abs a <= 1.0e-12++-- | @'abs' a '<=' 1e-6@+--+instance Epsilon CFloat where+  nearZero a = abs a <= 1.0e-6++-- | @'abs' a '<=' 1e-12@+--+instance Epsilon CDouble where+  nearZero a = abs a <= 1.0e-12+
+ src/Data/Array/Accelerate/Linear/Lift.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Lift+-- Copyright   : 2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Stability   : experimental+-- Portability : non-portable+--+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Lift ( liftLens, unlift' )+  where++import Data.Array.Accelerate+import Data.Array.Accelerate.Linear.Type+++-- Lift a 'Lens' into Accelerate terms+--+liftLens+    :: (Functor f, Unlift box s, Unlift box t, Unlift box b, Lift box a)+    => ((a -> f b) -> s -> f t)                         -- Lens s t a b+    -> (box (Plain a) -> f (box (Plain b)))+    -> box (Plain s)+    -> f (box (Plain t))+liftLens l f x = lift `fmap` l (fsink1 f) (unlift x)+++-- | Sink a unary functor from Accelerate terms+--+fsink1 :: (Functor f, Unlift box b, Lift box a)+       => (box (Plain a) -> f (box (Plain b)))+       -> a+       -> f b+fsink1 f = fmap unlift . f . lift+++-- | 'unlift' through two surface types+--+unlift' :: forall f g a. (Functor f, Box f (g a), Box g a)+        => Exp (f (g a))+        -> f (g (Exp a))+unlift' x = fmap unlift (unlift x :: f (Exp (g a)))+
+ src/Data/Array/Accelerate/Linear/Matrix.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Matrix+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Simple matrix operations for low-dimensional primitives+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Matrix (++  M22, M23, M24, M32, M33, M34, M42, M43, M44,+  (!*!), (!+!), (!-!), (!*), (*!), (!!*), (*!!), (!!/),+  transpose,+  identity,+  Trace(..),++) where++import Data.Array.Accelerate                    as A hiding ( transpose )+import Data.Array.Accelerate.Data.Complex++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Plucker+import Data.Array.Accelerate.Linear.Quaternion+import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.V0+import Data.Array.Accelerate.Linear.V1+import Data.Array.Accelerate.Linear.V2+import Data.Array.Accelerate.Linear.V3+import Data.Array.Accelerate.Linear.V4+import Data.Array.Accelerate.Linear.Vector++import Linear.Matrix                            ( M22, M23, M24, M32, M33, M34, M42, M43, M44 )+import qualified Linear.Matrix                  as L++import Data.Distributive+import Data.Foldable+import Data.Traversable+import Control.Applicative+import Prelude                                  as P+++infixl 7 !*!+-- | Matrix product. This can compute any combination of sparse and dense multiplication.+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) !*! V3 (V2 1 2) (V2 3 4) (V2 4 5)+-- V2 (V2 19 25) (V2 43 58)+--+-- >>> V2 (fromList [(1,2)]) (fromList [(2,3)]) !*! fromList [(1,V3 0 0 1), (2, V3 0 0 5)]+-- V2 (V3 0 0 2) (V3 0 0 15)+--+(!*!) :: (Functor m, Foldable t, Additive t, Additive n, A.Num a, Box2 m t a, Box2 t n a, Box2 m n a)+      => Exp (m (t a))+      -> Exp (t (n a))+      -> Exp (m (n a))+f !*! g = lift (unlift' f L.!*! unlift' g)+++infixl 6 !+!+-- | Entry-wise matrix addition.+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) !+! V2 (V3 7 8 9) (V3 1 2 3)+-- V2 (V3 8 10 12) (V3 5 7 9)+--+(!+!) :: (Additive m, Additive n, A.Num a, Box2 m n a)+      => Exp (m (n a))+      -> Exp (m (n a))+      -> Exp (m (n a))+f !+! g = lift (unlift' f L.!+! unlift' g)+++infixl 6 !-!+-- | Entry-wise matrix subtraction.+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) !-! V2 (V3 7 8 9) (V3 1 2 3)+-- V2 (V3 (-6) (-6) (-6)) (V3 3 3 3)+--+(!-!) :: (Additive m, Additive n, A.Num a, Box2 m n a)+      => Exp (m (n a))+      -> Exp (m (n a))+      -> Exp (m (n a))+f !-! g = lift (unlift' f L.!-! unlift' g)+++infixl 7 !*+-- | Matrix * column vector+--+-- >>> V2 (V3 1 2 3) (V3 4 5 6) !* V3 7 8 9+-- V2 50 122+--+(!*) :: (Functor m, Foldable r, Additive r, A.Num a, Box2 m r a, Box m a)+     => Exp (m (r a))+     -> Exp (r a)+     -> Exp (m a)+m !* v = lift (unlift' m L.!* unlift v)+++infixl 7 *!+-- | Row vector * matrix+--+-- >>> V2 1 2 *! V2 (V3 3 4 5) (V3 6 7 8)+-- V3 15 18 21++-- (*!) :: (Metric r, Additive n, Num a) => r a -> r (n a) -> n a+-- f *! g = dot f <$> distribute g+--+(*!) :: (Foldable t, Additive f, Additive t, A.Num a, Box t a, Box f a, Box2 t f a)+     => Exp (t a)+     -> Exp (t (f a))+     -> Exp (f a)+f *! g = lift (unlift f L.*! unlift' g)+++infixl 7 *!!+-- | Scalar-matrix product+--+-- >>> 5 *!! V2 (V2 1 2) (V2 3 4)+-- V2 (V2 5 10) (V2 15 20)+--+(*!!) :: (Functor m, Functor r, A.Num a, Box2 m r a)+      => Exp a+      -> Exp (m (r a))+      -> Exp (m (r a))+s *!! m = lift (unlift s L.*!! unlift' m)+++infixl 7 !!*+-- | Matrix-scalar product+--+-- >>> V2 (V2 1 2) (V2 3 4) !!* 5+-- V2 (V2 5 10) (V2 15 20)+--+(!!*) :: (Functor m, Functor r, A.Num a, Box2 m r a)+      => Exp (m (r a))+      -> Exp a+      -> Exp (m (r a))+(!!*) = flip (*!!)+++infixl 7 !!/+-- | Matrix-scalar division+--+(!!/) :: (Functor m, Functor r, A.Floating a, Box2 m r a)+      => Exp (m (r a))+      -> Exp a+      -> Exp (m (r a))+m !!/ s = lift (unlift' m L.!!/ unlift s)+++-- |The identity matrix for any dimension vector.+--+-- >>> identity :: M44 Int+-- V4 (V4 1 0 0 0) (V4 0 1 0 0) (V4 0 0 1 0) (V4 0 0 0 1)+--+-- >>> identity :: V3 (V3 Int)+-- V3 (V3 1 0 0) (V3 0 1 0) (V3 0 0 1)+--+identity :: forall t a. (Traversable t, Applicative t, A.Num a, Box2 t t a) => Exp (t (t a))+identity = lift (L.identity :: t (t (Exp a)))+++-- | 'transpose' is just an alias for 'distribute'+--+-- > transpose (V3 (V2 1 2) (V2 3 4) (V2 5 6))+-- V2 (V3 1 3 5) (V3 2 4 6)+--+transpose+    :: (Distributive g, Functor f, Box2 f g a, Box2 g f a)+    => Exp (f (g a))+    -> Exp (g (f a))+transpose = lift . L.transpose . unlift'+++class L.Trace m => Trace m where+  -- | Compute the trace of a matrix+  trace :: (A.Num a, Box2 m m a) => Exp (m (m a)) -> Exp a+  trace = lift . L.trace . unlift'++  -- | Compute the diagonal of a matrix+  diagonal :: Box2 m m a => Exp (m (m a)) -> Exp (m a)+  diagonal = lift . L.diagonal . unlift'++instance Trace Complex+instance Trace V0+instance Trace V1+instance Trace V2+instance Trace V3+instance Trace V4+instance Trace Plucker+instance Trace Quaternion+
+ src/Data/Array/Accelerate/Linear/Metric.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Metric+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Free metric spaces+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Metric+  where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.Epsilon+import Data.Array.Accelerate.Linear.Vector++import qualified Linear.Metric                  as L+++-- | Free and sparse inner product/metric spaces.+--+class L.Metric f => Metric f where++  -- | Compute the inner product of two vectors or (equivalently) convert a+  -- vector @f a@ into a covector @f a -> a@.+  --+  -- >>> V2 1 2 `dot` V2 3 4+  -- 11+  --+  dot :: forall a. (A.Num a, Box f a)+      => Exp (f a)+      -> Exp (f a)+      -> Exp a+  dot = lift2 (L.dot :: f (Exp a) -> f (Exp a) -> Exp a)++  -- | Compute the squared norm. The name quadrance arises from Norman J.+  -- Wildberger's rational trigonometry.+  --+  quadrance+      :: forall a. (A.Num a, Box f a)+      => Exp (f a)+      -> Exp a+  quadrance = lift1 (L.quadrance :: f (Exp a) -> Exp a)++  -- | Compute the 'quadrance' of the difference+  --+  qd :: forall a. (A.Num a, Box f a)+     => Exp (f a)+     -> Exp (f a)+     -> Exp a+  qd = lift2 (L.qd :: f (Exp a) -> f (Exp a) -> Exp a)++  -- | Compute the distance between two vectors in a metric space+  --+  distance+      :: forall a. (A.Floating a, Box f a)+      => Exp (f a)+      -> Exp (f a)+      -> Exp a+  distance = lift2 (L.distance :: f (Exp a) -> f (Exp a) -> Exp a)++  -- | Compute the norm of a vector in a metric space+  --+  norm :: forall a. (A.Floating a, Box f a)+       => Exp (f a)+       -> Exp a+  norm = lift1 (L.norm :: f (Exp a) -> Exp a)++  -- | Convert a non-zero vector to unit vector.+  --+  signorm+      :: forall a. (A.Floating a, Box f a)+      => Exp (f a)+      -> Exp (f a)+  signorm = lift1 (L.signorm :: f (Exp a) -> f (Exp a))+++type IsMetric f a = (Metric f, Box f a)+++-- | Normalize a 'Metric' functor to have unit 'norm'. This function does not+-- change the functor if its 'norm' is 0 or 1.+--+normalize+    :: (Elt (f a), A.Floating a, IsMetric f a, Epsilon a)+    => Exp (f a)+    -> Exp (f a)+normalize v+  = nearZero l || nearZero (1-l)+  ? ( v, v ^/ sqrt l )+  where+    l = quadrance v++-- | @project u v@ computes the projection of @v@ onto @u@.+--+project+    :: forall f a. (A.Floating a, IsMetric f a)+    => Exp (f a)+    -> Exp (f a)+    -> Exp (f a)+project = lift2 (L.project :: f (Exp a) -> f (Exp a) -> f (Exp a))+
+ src/Data/Array/Accelerate/Linear/Plucker.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE DeriveDataTypeable    #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Plucker+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Plücker coordinates for lines in 3d homogeneous space.+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Plucker (++  Plucker(..), squaredError, (><), plucker, plucker3D,++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Vector+import Data.Array.Accelerate.Linear.V3+import Data.Array.Accelerate.Linear.V4++import Data.Typeable+import Control.Lens+import Linear.Plucker                           ( Plucker(..) )+import qualified Linear.Plucker                 as L+++-- | Valid Plücker coordinates @p@ will have @'squaredError' p '==' 0@+--+-- That said, floating point makes a mockery of this claim, so you may want to+-- use 'nearZero'.+--+squaredError :: forall a. A.Num a => Exp (Plucker a) -> Exp a+squaredError = lift1 (L.squaredError :: Plucker (Exp a) -> Exp a)++-- | This isn't the actual metric because this bilinear form gives rise to an+-- isotropic quadratic space+--+infixl 5 ><+(><) :: forall a. A.Num a => Exp (Plucker a) -> Exp (Plucker a) -> Exp a+(><) = lift2 ((L.><) :: Plucker (Exp a) -> Plucker (Exp a) -> Exp a)++-- | Given a pair of points represented by homogeneous coordinates generate+-- Plücker coordinates for the line through them, directed from the second+-- towards the first.+--+plucker :: forall a. A.Num a => Exp (V4 a) -> Exp (V4 a) -> Exp (Plucker a)+plucker = lift2 (L.plucker :: V4 (Exp a) -> V4 (Exp a) -> Plucker (Exp a))++-- | Given a pair of 3D points, generate Plücker coordinates for the line+-- through them, directed from the second towards the first.+--+plucker3D :: forall a. A.Num a => Exp (V3 a) -> Exp (V3 a) -> Exp (Plucker a)+plucker3D = lift2 (L.plucker3D :: V3 (Exp a) -> V3 (Exp a) -> Plucker (Exp a))+++-- Instances+-- ---------++deriving instance Typeable Plucker++instance Metric Plucker+instance Additive Plucker++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)++instance cst a => IsProduct cst (Plucker a) where+  type ProdRepr (Plucker a) = ProdRepr (a,a,a,a,a,a)+  fromProd p (Plucker x y z w u v) = fromProd p (x, y, z, w, u, v)+  toProd p t = case toProd p t of+     (x, y, z, w, u, v) -> Plucker x y z w u v+  prod p _ = prod p (undefined :: (a,a,a,a,a,a))++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+  lift (Plucker x y z w u v) =+    Exp $ Tuple $+      NilTup `SnocTup` lift x+             `SnocTup` lift y+             `SnocTup` lift z+             `SnocTup` lift w+             `SnocTup` lift u+             `SnocTup` lift v++instance Elt a => Unlift Exp (Plucker (Exp a)) 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)++instance (Elt a, Elt b) => Each (Exp (Plucker a)) (Exp (Plucker b)) (Exp a) (Exp b) where+  each = liftLens (each :: Traversal (Plucker (Exp a)) (Plucker (Exp b)) (Exp a) (Exp b))+
+ src/Data/Array/Accelerate/Linear/Quaternion.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Quaternion+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Quaternions+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Quaternion (++  Quaternion(..),++) where++import Data.Array.Accelerate+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Vector+import Data.Array.Accelerate.Linear.V3++import Control.Lens+import Linear.Quaternion                        ( Quaternion(..) )+++-- Instances+-- ---------++instance Metric Quaternion+instance Additive Quaternion++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)++instance cst a => IsProduct cst (Quaternion a) where+  type ProdRepr (Quaternion a) = ProdRepr (a,a,a,a)+  fromProd p (Quaternion x (V3 y z w)) = fromProd p (x,y,z,w)+  toProd p t = case toProd p t of+     (x, y, z, w) -> Quaternion x (V3 y z w)+  prod p _ = prod p (undefined :: (a,a,a,a))++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 => Unlift Exp (Quaternion (Exp a)) 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))++instance (Elt a, Elt b) => Each (Exp (Quaternion a)) (Exp (Quaternion b)) (Exp a) (Exp b) where+  each = liftLens (each :: Traversal (Quaternion (Exp a)) (Quaternion (Exp b)) (Exp a) (Exp b))+
+ src/Data/Array/Accelerate/Linear/Type.hs view
@@ -0,0 +1,25 @@+{-# LANGUAGE ConstraintKinds  #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies     #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Type+-- Copyright   : 2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Type+  where++import Data.Array.Accelerate++type Box f a            = (Unlift Exp (f (Exp a)), Plain (f (Exp a)) ~ f a)+type Box2 f g a         = (Box f (g a), Box g a, Lift Exp (f (g (Exp a))), Plain (f (g (Exp a))) ~ f (g a))++-- type IsLens' s a        = IsLens s s a a+-- type IsLens s t a b     = (Lift Exp t, Lift Exp a, Unlift Exp s, Unlift Exp b)+
+ src/Data/Array/Accelerate/Linear/V0.hs view
@@ -0,0 +1,79 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE IncoherentInstances   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.V0+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- 0-D Vectors+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.V0 (++  V0(..),++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Vector++import Linear.V0                                ( V0(..) )+import Control.Lens+import Control.Applicative+import Prelude                                  as P+++-- Instances+-- ---------++instance Metric V0+instance Additive V0++type instance EltRepr (V0 a) = ()++instance Elt a => Elt (V0 a) where+  eltType _ = eltType ()+  toElt () = V0+  fromElt V0 = ()++instance IsProduct cst (V0 a) where+  type ProdRepr (V0 a) = ()+  fromProd _ V0 = ()+  toProd _ () = V0+  prod _ _ = ProdRunit++instance Lift Exp (V0 a) where+  type Plain (V0 a) = ()+  lift V0 = Exp (Tuple NilTup)++instance Unlift Exp (V0 a) where+  unlift _ = V0++instance A.Num a => P.Num (Exp (V0 a)) where+  _ + _ = constant V0+  _ - _ = constant V0+  _ * _ = constant V0+  abs _ = constant V0+  signum _ = constant V0+  fromInteger _ = constant V0++instance (Elt a, Elt b) => Each (Exp (V0 a)) (Exp (V0 b)) (Exp a) (Exp b) where+  each _ _ = pure (constant V0)+
+ src/Data/Array/Accelerate/Linear/V1.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE IncoherentInstances   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ViewPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.V1+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- 1-D Vectors+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.V1 (++  V1(..), R1(..), ex,++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.Vector++import Control.Lens+import Linear.V1                                ( V1(..) )+import qualified Linear.V1                      as L+import Prelude                                  as P+++-- | A space that has at least 1 basis vector '_x'.+--+class L.R1 t => R1 t where+  -- |+  -- >>> V1 2 ^._x+  -- 2+  --+  -- >>> V1 2 & _x .~ 3+  -- V1 3+  --+  _x :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)+  _x = liftLens (L._x :: Lens' (t (Exp a)) (Exp a))+++ex :: R1 t => E t+ex = E _x+++-- Instances+-- ---------++instance Metric V1+instance Additive V1+instance R1 V1++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++instance cst a => IsProduct cst (V1 a) where+  type ProdRepr (V1 a) = ((), a)+  fromProd _ (V1 x) = ((), x)+  toProd _ ((), x) = V1 x+  prod _ _ = ProdRsnoc ProdRunit++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 => Unlift Exp (V1 (Exp a)) where+  unlift t = V1 $ Exp $ ZeroTupIdx `Prj` t++instance A.Num a => P.Num (Exp (V1 a)) where+  (+)             = lift2 ((+) :: V1 (Exp a) -> V1 (Exp a) -> V1 (Exp a))+  (-)             = lift2 ((-) :: V1 (Exp a) -> V1 (Exp a) -> V1 (Exp a))+  (*)             = lift2 ((*) :: V1 (Exp a) -> V1 (Exp a) -> V1 (Exp a))+  negate          = lift1 (negate :: V1 (Exp a) -> V1 (Exp a))+  signum          = lift1 (signum :: V1 (Exp a) -> V1 (Exp a))+  abs             = lift1 (signum :: V1 (Exp a) -> V1 (Exp a))+  fromInteger x   = lift (fromInteger x :: V1 (Exp a))++instance A.Floating a => P.Fractional (Exp (V1 a)) where+  (/)             = lift2 ((/) :: V1 (Exp a) -> V1 (Exp a) -> V1 (Exp a))+  recip           = lift1 (recip :: V1 (Exp a) -> V1 (Exp a))+  fromRational x  = lift (fromRational x :: V1 (Exp a))++instance A.Floating a => P.Floating (Exp (V1 a)) where+  pi              = lift (pi :: V1 (Exp a))+  log             = lift1 (log :: V1 (Exp a) -> V1 (Exp a))+  exp             = lift1 (exp :: V1 (Exp a) -> V1 (Exp a))+  sin             = lift1 (sin :: V1 (Exp a) -> V1 (Exp a))+  cos             = lift1 (cos :: V1 (Exp a) -> V1 (Exp a))+  tan             = lift1 (tan :: V1 (Exp a) -> V1 (Exp a))+  sinh            = lift1 (sinh :: V1 (Exp a) -> V1 (Exp a))+  cosh            = lift1 (cosh :: V1 (Exp a) -> V1 (Exp a))+  tanh            = lift1 (tanh :: V1 (Exp a) -> V1 (Exp a))+  asin            = lift1 (asin :: V1 (Exp a) -> V1 (Exp a))+  acos            = lift1 (acos :: V1 (Exp a) -> V1 (Exp a))+  atan            = lift1 (atan :: V1 (Exp a) -> V1 (Exp a))+  asinh           = lift1 (asinh :: V1 (Exp a) -> V1 (Exp a))+  acosh           = lift1 (acosh :: V1 (Exp a) -> V1 (Exp a))+  atanh           = lift1 (atanh :: V1 (Exp a) -> V1 (Exp a))++instance (Elt a, Elt b) => Each (Exp (V1 a)) (Exp (V1 b)) (Exp a) (Exp b) where+  each = liftLens (each :: Traversal (V1 (Exp a)) (V1 (Exp b)) (Exp a) (Exp b))+
+ src/Data/Array/Accelerate/Linear/V2.hs view
@@ -0,0 +1,160 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE IncoherentInstances   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ViewPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.V2+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- 2-D Vectors+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.V2 (++  V2(..), R1(..), R2(..),+  _yx,+  ex, ey,+  perp, angle,++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.V1+import Data.Array.Accelerate.Linear.Vector++import Control.Lens+import Linear.V2                                ( V2(..) )+import qualified Linear.V2                      as L+import Prelude                                  as P+++-- | the counter-clockwise perpendicular vector+--+-- >>> perp $ V2 10 20+-- V2 (-20) 10+--+perp :: forall a. A.Num a => Exp (V2 a) -> Exp (V2 a)+perp = lift1 (L.perp :: V2 (Exp a) -> V2 (Exp a))+++-- | Unit vector with given phase angle (modulo 2*'pi')+--+angle :: A.Floating a => Exp a -> Exp (V2 a)+angle = lift . L.angle+++-- | A space that distinguishes 2 orthogonal basis vectors '_x' and '_y', but+-- may have more.+--+class (L.R2 t, R1 t) => R2 t where+  -- |+  -- >>> V2 1 2 ^._y+  -- 2+  --+  -- >>> V2 1 2 & _y .~ 3+  -- V2 1 3+  --+  _y :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)+  _y = liftLens (L._y :: Lens' (t (Exp a)) (Exp a))++  _xy :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))+  _xy = liftLens (L._xy :: Lens' (t (Exp a)) (V2 (Exp a)))+++-- |+-- >>> V2 1 2 ^. _yx+-- V2 2 1+--+_yx :: forall t a. (R2 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))+_yx = liftLens (L._yx :: Lens' (t (Exp a)) (V2 (Exp a)))+++ey :: R2 t => E t+ey = E _y+++-- Instances+-- ---------++instance Metric V2+instance Additive V2+instance R1 V2+instance R2 V2++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)++instance cst a => IsProduct cst (V2 a) where+  type ProdRepr (V2 a) = ProdRepr (a,a)+  fromProd p (V2 x y) = fromProd p (x,y)+  toProd p t = case toProd p t of+     (x, y) -> V2 x y+  prod p _ = prod p (undefined :: (a,a))++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V2 a) where+  type Plain (V2 a) = V2 (Plain a)+  lift (V2 x y) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y++instance Elt a => Unlift Exp (V2 (Exp a)) where+  unlift t = V2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+                (Exp $ ZeroTupIdx `Prj` t)++instance A.Num a => P.Num (Exp (V2 a)) where+  (+)             = lift2 ((+) :: V2 (Exp a) -> V2 (Exp a) -> V2 (Exp a))+  (-)             = lift2 ((-) :: V2 (Exp a) -> V2 (Exp a) -> V2 (Exp a))+  (*)             = lift2 ((*) :: V2 (Exp a) -> V2 (Exp a) -> V2 (Exp a))+  negate          = lift1 (negate :: V2 (Exp a) -> V2 (Exp a))+  signum          = lift1 (signum :: V2 (Exp a) -> V2 (Exp a))+  abs             = lift1 (signum :: V2 (Exp a) -> V2 (Exp a))+  fromInteger x   = lift (fromInteger x :: V2 (Exp a))++instance A.Floating a => P.Fractional (Exp (V2 a)) where+  (/)             = lift2 ((/) :: V2 (Exp a) -> V2 (Exp a) -> V2 (Exp a))+  recip           = lift1 (recip :: V2 (Exp a) -> V2 (Exp a))+  fromRational x  = lift (fromRational x :: V2 (Exp a))++instance A.Floating a => P.Floating (Exp (V2 a)) where+  pi              = lift (pi :: V2 (Exp a))+  log             = lift1 (log :: V2 (Exp a) -> V2 (Exp a))+  exp             = lift1 (exp :: V2 (Exp a) -> V2 (Exp a))+  sin             = lift1 (sin :: V2 (Exp a) -> V2 (Exp a))+  cos             = lift1 (cos :: V2 (Exp a) -> V2 (Exp a))+  tan             = lift1 (tan :: V2 (Exp a) -> V2 (Exp a))+  sinh            = lift1 (sinh :: V2 (Exp a) -> V2 (Exp a))+  cosh            = lift1 (cosh :: V2 (Exp a) -> V2 (Exp a))+  tanh            = lift1 (tanh :: V2 (Exp a) -> V2 (Exp a))+  asin            = lift1 (asin :: V2 (Exp a) -> V2 (Exp a))+  acos            = lift1 (acos :: V2 (Exp a) -> V2 (Exp a))+  atan            = lift1 (atan :: V2 (Exp a) -> V2 (Exp a))+  asinh           = lift1 (asinh :: V2 (Exp a) -> V2 (Exp a))+  acosh           = lift1 (acosh :: V2 (Exp a) -> V2 (Exp a))+  atanh           = lift1 (atanh :: V2 (Exp a) -> V2 (Exp a))++instance (Elt a, Elt b) => Each (Exp (V2 a)) (Exp (V2 b)) (Exp a) (Exp b) where+  each = liftLens (each :: Traversal (V2 (Exp a)) (V2 (Exp b)) (Exp a) (Exp b))+
+ src/Data/Array/Accelerate/Linear/V3.hs view
@@ -0,0 +1,198 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE IncoherentInstances   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ViewPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.V3+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- 3-D Vectors+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.V3 (++  V3(..), cross, triple,+  R1(..),+  R2(..),+  _yx,+  R3(..),+  _xz, _yz, _zx, _zy,+  _xzy, _yxz, _yzx, _zxy, _zyx,+  ex, ey, ez,++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.V1+import Data.Array.Accelerate.Linear.V2+import Data.Array.Accelerate.Linear.Vector++import Control.Lens+import Linear.V3                                ( V3(..) )+import qualified Linear.V3                      as L+import Prelude                                  as P+++-- | cross product+--+cross :: forall a. A.Num a => Exp (V3 a) -> Exp (V3 a) -> Exp (V3 a)+cross = lift2 (L.cross :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a))++-- | scalar triple product+--+triple :: forall a. A.Num a => Exp (V3 a) -> Exp (V3 a) -> Exp (V3 a) -> Exp a+triple = lift3 (L.triple :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a) -> Exp a)+++-- | A space that distinguishes 3 orthogonal basis vectors: '_x', '_y', and '_z'.+-- (Although it may have more)+--+class (L.R3 t, R2 t) => R3 t where+  -- |+  -- >>> V3 1 2 3 ^. _z+  -- 3+  --+  _z :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)+  _z = liftLens (L._z :: Lens' (t (Exp a)) (Exp a))++  _xyz :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))+  _xyz = liftLens (L._xyz :: Lens' (t (Exp a)) (V3 (Exp a)))+++_xz, _yz, _zx, _zy :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))+_xz = liftLens (L._xz :: Lens' (t (Exp a)) (V2 (Exp a)))+_yz = liftLens (L._yz :: Lens' (t (Exp a)) (V2 (Exp a)))+_zx = liftLens (L._zx :: Lens' (t (Exp a)) (V2 (Exp a)))+_zy = liftLens (L._zy :: Lens' (t (Exp a)) (V2 (Exp a)))++_xzy, _yxz, _yzx, _zxy, _zyx :: forall t a. (R3 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V3 a))+_xzy = liftLens (L._xzy :: Lens' (t (Exp a)) (V3 (Exp a)))+_yxz = liftLens (L._yxz :: Lens' (t (Exp a)) (V3 (Exp a)))+_yzx = liftLens (L._yzx :: Lens' (t (Exp a)) (V3 (Exp a)))+_zxy = liftLens (L._zxy :: Lens' (t (Exp a)) (V3 (Exp a)))+_zyx = liftLens (L._zyx :: Lens' (t (Exp a)) (V3 (Exp a)))+++ez :: R3 t => E t+ez = E _z+++-- Instances+-- ---------++instance Metric V3+instance Additive V3+instance R1 V3+instance R2 V3+instance R3 V3++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)++instance cst a => IsProduct cst (V3 a) where+  type ProdRepr (V3 a) = ProdRepr (a,a,a)+  fromProd p (V3 x y z) = fromProd p (x,y,z)+  toProd p t = case toProd p t of+     (x, y, z) -> V3 x y z+  prod p _ = prod p (undefined :: (a,a,a))++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V3 a) where+  type Plain (V3 a) = V3 (Plain a)+  lift (V3 x y z) = Exp $ Tuple $ NilTup `SnocTup` lift x `SnocTup` lift y `SnocTup` lift z++instance Elt a => Unlift Exp (V3 (Exp a)) where+  unlift t = V3 (Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` t)+                (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)+                (Exp $ ZeroTupIdx `Prj` t)++instance A.Num a => P.Num (Exp (V3 a)) where+  (+)             = lift2 ((+) :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a))+  (-)             = lift2 ((-) :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a))+  (*)             = lift2 ((*) :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a))+  negate          = lift1 (negate :: V3 (Exp a) -> V3 (Exp a))+  signum          = lift1 (signum :: V3 (Exp a) -> V3 (Exp a))+  abs             = lift1 (signum :: V3 (Exp a) -> V3 (Exp a))+  fromInteger x   = lift (fromInteger x :: V3 (Exp a))++instance A.Floating a => P.Fractional (Exp (V3 a)) where+  (/)             = lift2 ((/) :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a))+  recip           = lift1 (recip :: V3 (Exp a) -> V3 (Exp a))+  fromRational x  = lift (fromRational x :: V3 (Exp a))++instance A.Floating a => P.Floating (Exp (V3 a)) where+  pi              = lift (pi :: V3 (Exp a))+  log             = lift1 (log :: V3 (Exp a) -> V3 (Exp a))+  exp             = lift1 (exp :: V3 (Exp a) -> V3 (Exp a))+  sin             = lift1 (sin :: V3 (Exp a) -> V3 (Exp a))+  cos             = lift1 (cos :: V3 (Exp a) -> V3 (Exp a))+  tan             = lift1 (tan :: V3 (Exp a) -> V3 (Exp a))+  sinh            = lift1 (sinh :: V3 (Exp a) -> V3 (Exp a))+  cosh            = lift1 (cosh :: V3 (Exp a) -> V3 (Exp a))+  tanh            = lift1 (tanh :: V3 (Exp a) -> V3 (Exp a))+  asin            = lift1 (asin :: V3 (Exp a) -> V3 (Exp a))+  acos            = lift1 (acos :: V3 (Exp a) -> V3 (Exp a))+  atan            = lift1 (atan :: V3 (Exp a) -> V3 (Exp a))+  asinh           = lift1 (asinh :: V3 (Exp a) -> V3 (Exp a))+  acosh           = lift1 (acosh :: V3 (Exp a) -> V3 (Exp a))+  atanh           = lift1 (atanh :: V3 (Exp a) -> V3 (Exp a))++instance (Elt a, Elt b) => Each (Exp (V3 a)) (Exp (V3 b)) (Exp a) (Exp b) where+  each = liftLens (each :: Traversal (V3 (Exp a)) (V3 (Exp b)) (Exp a) (Exp b))++-- $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!+{--+type instance ArrRepr (V3 a) = ArrRepr (Vector a)++instance Elt a => Arrays (V3 a) where+  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+  flavour _ = error "https://github.com/AccelerateHS/accelerate/issues/263"++instance Elt a => Lift Acc (V3 a) where+  type Plain (V3 a) = Vector a+  lift = lift . toArr'+--}+
+ src/Data/Array/Accelerate/Linear/V4.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE IncoherentInstances   #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ViewPatterns          #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.V4+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- 4-D Vectors+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.V4 (++  V4(..), vector, point, normalizePoint,+  R1(..),+  R2(..),+  _yx,+  R3(..),+  _xz, _yz, _zx, _zy,+  _xzy, _yxz, _yzx, _zxy, _zyx,+  R4(..),+  _xw, _yw, _zw, _wx, _wy, _wz,+  _xyw, _xzw, _xwy, _xwz, _yxw, _yzw, _ywx, _ywz, _zxw, _zyw, _zwx, _zwy,+  _wxy, _wxz, _wyx, _wyz, _wzx, _wzy,+  _xywz, _xzyw, _xzwy, _xwyz, _xwzy, _yxzw , _yxwz, _yzxw, _yzwx, _ywxz,+  _ywzx, _zxyw, _zxwy, _zyxw, _zywx, _zwxy, _zwyx, _wxyz, _wxzy, _wyxz,+  _wyzx, _wzxy, _wzyx,+  ex, ey, ez, ew,++) where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Product+import Data.Array.Accelerate.Array.Sugar++import Data.Array.Accelerate.Linear.Lift+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.Type+import Data.Array.Accelerate.Linear.V1+import Data.Array.Accelerate.Linear.V2+import Data.Array.Accelerate.Linear.V3+import Data.Array.Accelerate.Linear.Vector++import Control.Lens+import Linear.V4                                ( V4(..) )+import qualified Linear.V4                      as L+import Prelude                                  as P+++-- | Convert a 3-dimensional affine vector into a 4-dimensional homogeneous+-- vector.+--+vector :: forall a. A.Num a => Exp (V3 a) -> Exp (V4 a)+vector = lift1 (L.vector :: V3 (Exp a) -> V4 (Exp a))++-- | Convert a 3-dimensional affine point into a 4-dimensional homogeneous+-- vector.+--+point :: forall a. A.Num a => Exp (V3 a) -> Exp (V4 a)+point = lift1 (L.point :: V3 (Exp a) -> V4 (Exp a))++-- | Convert 4-dimensional projective coordinates to a 3-dimensional point. This+-- operation may be denoted, @euclidean [x:y:z:w] = (x\/w, y\/w, z\/w)@ where+-- the projective, homogenous, coordinate @[x:y:z:w]@ is one of many associated+-- with a single point @(x\/w, y\/w, z\/w)@.+--+normalizePoint :: forall a. A.Floating a => Exp (V4 a) -> Exp (V3 a)+normalizePoint = lift1 (L.normalizePoint :: V4 (Exp a) -> V3 (Exp a))++-- | A space that distinguishes orthogonal basis vectors '_x', '_y', '_z', and '_w'.+-- (Although it may have more.)+--+class (L.R4 t, R3 t) => R4 t where+  -- |+  -- >>> V4 1 2 3 4 ^._w+  -- 4+  --+  _w :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)+  _w = liftLens (L._w :: Lens' (t (Exp a)) (Exp a))++  _xyzw :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V4 a))+  _xyzw = liftLens (L._xyzw :: Lens' (t (Exp a)) (V4 (Exp a)))+++_xw, _yw, _zw, _wx, _wy, _wz+    :: forall t a. (R4 t, Elt a, Box t a)+    => Lens' (Exp (t a)) (Exp (V2 a))+_xw = liftLens (L._xw :: Lens' (t (Exp a)) (V2 (Exp a)))+_yw = liftLens (L._yw :: Lens' (t (Exp a)) (V2 (Exp a)))+_zw = liftLens (L._zw :: Lens' (t (Exp a)) (V2 (Exp a)))+_wx = liftLens (L._wx :: Lens' (t (Exp a)) (V2 (Exp a)))+_wy = liftLens (L._wy :: Lens' (t (Exp a)) (V2 (Exp a)))+_wz = liftLens (L._wz :: Lens' (t (Exp a)) (V2 (Exp a)))++_xyw, _xzw, _xwy, _xwz, _yxw, _yzw, _ywx, _ywz, _zxw, _zyw, _zwx, _zwy, _wxy, _wxz, _wyx, _wyz, _wzx, _wzy+    :: forall t a. (R4 t, Elt a, Box t a)+    => Lens' (Exp (t a)) (Exp (V3 a))+_xyw = liftLens (L._xyw :: Lens' (t (Exp a)) (V3 (Exp a)))+_xzw = liftLens (L._xzw :: Lens' (t (Exp a)) (V3 (Exp a)))+_xwy = liftLens (L._xwy :: Lens' (t (Exp a)) (V3 (Exp a)))+_xwz = liftLens (L._xwz :: Lens' (t (Exp a)) (V3 (Exp a)))+_yxw = liftLens (L._yxw :: Lens' (t (Exp a)) (V3 (Exp a)))+_yzw = liftLens (L._yzw :: Lens' (t (Exp a)) (V3 (Exp a)))+_ywx = liftLens (L._ywx :: Lens' (t (Exp a)) (V3 (Exp a)))+_ywz = liftLens (L._ywz :: Lens' (t (Exp a)) (V3 (Exp a)))+_zxw = liftLens (L._zxw :: Lens' (t (Exp a)) (V3 (Exp a)))+_zyw = liftLens (L._zyw :: Lens' (t (Exp a)) (V3 (Exp a)))+_zwx = liftLens (L._zwx :: Lens' (t (Exp a)) (V3 (Exp a)))+_zwy = liftLens (L._zwy :: Lens' (t (Exp a)) (V3 (Exp a)))+_wxy = liftLens (L._wxy :: Lens' (t (Exp a)) (V3 (Exp a)))+_wxz = liftLens (L._wxz :: Lens' (t (Exp a)) (V3 (Exp a)))+_wyx = liftLens (L._wyx :: Lens' (t (Exp a)) (V3 (Exp a)))+_wyz = liftLens (L._wyz :: Lens' (t (Exp a)) (V3 (Exp a)))+_wzx = liftLens (L._wzx :: Lens' (t (Exp a)) (V3 (Exp a)))+_wzy = liftLens (L._wzy :: Lens' (t (Exp a)) (V3 (Exp a)))++_xywz, _xzyw, _xzwy, _xwyz, _xwzy, _yxzw , _yxwz, _yzxw, _yzwx, _ywxz , _ywzx, _zxyw,+    _zxwy, _zyxw, _zywx, _zwxy, _zwyx, _wxyz, _wxzy, _wyxz, _wyzx, _wzxy, _wzyx+  :: forall t a. (R4 t, Elt a, Box t a)+  => Lens' (Exp (t a)) (Exp (V4 a))+_xywz = liftLens (L._xywz :: Lens' (t (Exp a)) (V4 (Exp a)))+_xzyw = liftLens (L._xzyw :: Lens' (t (Exp a)) (V4 (Exp a)))+_xzwy = liftLens (L._xzwy :: Lens' (t (Exp a)) (V4 (Exp a)))+_xwyz = liftLens (L._xwyz :: Lens' (t (Exp a)) (V4 (Exp a)))+_xwzy = liftLens (L._xwzy :: Lens' (t (Exp a)) (V4 (Exp a)))+_yxzw = liftLens (L._yxzw :: Lens' (t (Exp a)) (V4 (Exp a)))+_yxwz = liftLens (L._yxwz :: Lens' (t (Exp a)) (V4 (Exp a)))+_yzxw = liftLens (L._yzxw :: Lens' (t (Exp a)) (V4 (Exp a)))+_yzwx = liftLens (L._yzwx :: Lens' (t (Exp a)) (V4 (Exp a)))+_ywxz = liftLens (L._ywxz :: Lens' (t (Exp a)) (V4 (Exp a)))+_ywzx = liftLens (L._ywzx :: Lens' (t (Exp a)) (V4 (Exp a)))+_zxyw = liftLens (L._zxyw :: Lens' (t (Exp a)) (V4 (Exp a)))+_zxwy = liftLens (L._zxwy :: Lens' (t (Exp a)) (V4 (Exp a)))+_zyxw = liftLens (L._zyxw :: Lens' (t (Exp a)) (V4 (Exp a)))+_zywx = liftLens (L._zywx :: Lens' (t (Exp a)) (V4 (Exp a)))+_zwxy = liftLens (L._zwxy :: Lens' (t (Exp a)) (V4 (Exp a)))+_zwyx = liftLens (L._zwyx :: Lens' (t (Exp a)) (V4 (Exp a)))+_wxyz = liftLens (L._wxyz :: Lens' (t (Exp a)) (V4 (Exp a)))+_wxzy = liftLens (L._wxzy :: Lens' (t (Exp a)) (V4 (Exp a)))+_wyxz = liftLens (L._wyxz :: Lens' (t (Exp a)) (V4 (Exp a)))+_wyzx = liftLens (L._wyzx :: Lens' (t (Exp a)) (V4 (Exp a)))+_wzxy = liftLens (L._wzxy :: Lens' (t (Exp a)) (V4 (Exp a)))+_wzyx = liftLens (L._wzyx :: Lens' (t (Exp a)) (V4 (Exp a)))+++ew :: R4 t => E t+ew = E _w+++-- Instances+-- ---------++instance Metric V4+instance Additive V4+instance R1 V4+instance R2 V4+instance R3 V4+instance R4 V4++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)++instance cst a => IsProduct cst (V4 a) where+  type ProdRepr (V4 a) = ProdRepr (a,a,a,a)+  fromProd p (V4 x y z w) = fromProd p (x,y,z,w)+  toProd p t = case toProd p t of+     (x, y, z, w) -> V4 x y z w+  prod p _ = prod p (undefined :: (a,a,a,a))++instance (Lift Exp a, Elt (Plain a)) => Lift Exp (V4 a) where+  type Plain (V4 a) = V4 (Plain a)+  lift (V4 x y z w) =+    Exp $ Tuple $ NilTup `SnocTup` lift x+                         `SnocTup` lift y+                         `SnocTup` lift z+                         `SnocTup` lift w++instance Elt a => Unlift Exp (V4 (Exp a)) 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)++instance A.Num a => P.Num (Exp (V4 a)) where+  (+)             = lift2 ((+) :: V4 (Exp a) -> V4 (Exp a) -> V4 (Exp a))+  (-)             = lift2 ((-) :: V4 (Exp a) -> V4 (Exp a) -> V4 (Exp a))+  (*)             = lift2 ((*) :: V4 (Exp a) -> V4 (Exp a) -> V4 (Exp a))+  negate          = lift1 (negate :: V4 (Exp a) -> V4 (Exp a))+  signum          = lift1 (signum :: V4 (Exp a) -> V4 (Exp a))+  abs             = lift1 (signum :: V4 (Exp a) -> V4 (Exp a))+  fromInteger x   = lift (fromInteger x :: V4 (Exp a))++instance A.Floating a => P.Fractional (Exp (V4 a)) where+  (/)             = lift2 ((/) :: V4 (Exp a) -> V4 (Exp a) -> V4 (Exp a))+  recip           = lift1 (recip :: V4 (Exp a) -> V4 (Exp a))+  fromRational x  = lift (fromRational x :: V4 (Exp a))++instance A.Floating a => P.Floating (Exp (V4 a)) where+  pi              = lift (pi :: V4 (Exp a))+  log             = lift1 (log :: V4 (Exp a) -> V4 (Exp a))+  exp             = lift1 (exp :: V4 (Exp a) -> V4 (Exp a))+  sin             = lift1 (sin :: V4 (Exp a) -> V4 (Exp a))+  cos             = lift1 (cos :: V4 (Exp a) -> V4 (Exp a))+  tan             = lift1 (tan :: V4 (Exp a) -> V4 (Exp a))+  sinh            = lift1 (sinh :: V4 (Exp a) -> V4 (Exp a))+  cosh            = lift1 (cosh :: V4 (Exp a) -> V4 (Exp a))+  tanh            = lift1 (tanh :: V4 (Exp a) -> V4 (Exp a))+  asin            = lift1 (asin :: V4 (Exp a) -> V4 (Exp a))+  acos            = lift1 (acos :: V4 (Exp a) -> V4 (Exp a))+  atan            = lift1 (atan :: V4 (Exp a) -> V4 (Exp a))+  asinh           = lift1 (asinh :: V4 (Exp a) -> V4 (Exp a))+  acosh           = lift1 (acosh :: V4 (Exp a) -> V4 (Exp a))+  atanh           = lift1 (atanh :: V4 (Exp a) -> V4 (Exp a))++instance (Elt a, Elt b) => Each (Exp (V4 a)) (Exp (V4 b)) (Exp a) (Exp b) where+  each = liftLens (each :: Traversal (V4 (Exp a)) (V4 (Exp b)) (Exp a) (Exp b))+
+ src/Data/Array/Accelerate/Linear/Vector.hs view
@@ -0,0 +1,185 @@+{-# LANGUAGE ConstraintKinds     #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies        #-}+{-# LANGUAGE ViewPatterns        #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Vector+-- Copyright   : 2014 Edward Kmett, Charles Durham,+--               2015 Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Operations on free vector spaces+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Vector+  where++import Data.Array.Accelerate                    as A+import Data.Array.Accelerate.Linear.Type++import Control.Lens+import Prelude                                  as P+import qualified Linear.Vector                  as L++infixl 6 ^+^, ^+, +^, ^-^, ^-, -^+infixl 7 ^*, *^, ^/, /^++-- | A vector is an additive group with additional structure.+--+-- TODO: Support both 'Exp' and 'Acc'+--+class L.Additive f => Additive f where++  -- | The zero vector+  --+  zero :: (Elt (f a), P.Num a) => Exp (f a)+  zero = constant (L.zero)++  -- | Compute the sum of two vectors+  --+  -- >>> V2 1 2 ^+^ V2 3 4+  -- V2 4 6+  --+  (^+^) :: forall a. (A.Num a, Box f a)+        => Exp (f a)+        -> Exp (f a)+        -> Exp (f a)+  (^+^) = lift2 ((L.^+^) :: f (Exp a) -> f (Exp a) -> f (Exp a))++  -- | Compute the difference between two vectors+  --+  -- >>> V2 4 5 - V2 3 1+  -- V2 1 4+  --+  (^-^) :: forall a. (A.Num a, Box f a)+        => Exp (f a)+        -> Exp (f a)+        -> Exp (f a)+  (^-^) = lift2 ((L.^-^) :: f (Exp a) -> f (Exp a) -> f (Exp a))++  -- | Linearly interpolate between two vectors+  --+  lerp :: forall a. (A.Num a, Box f a)+       => Exp a+       -> Exp (f a)+       -> Exp (f a)+       -> Exp (f a)+  lerp = lift3 (L.lerp :: Exp a -> f (Exp a) -> f (Exp a) -> f (Exp a))+++type IsAdditive f a = (Additive f, Box f a)+++-- | Basis element+--+newtype E t = E {+    el :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)+  }+++-- | Compute the negation of a vector+--+-- >>> negated (V2 2 4)+-- V2 (-2) (-4)+--+negated+    :: forall f a. (Functor f, A.Num a, Box f a)+    => Exp (f a)+    -> Exp (f a)+negated = lift1 (L.negated :: f (Exp a) -> f (Exp a))++-- | Compute the left scalar product+--+-- >>> 2 *^ V2 3 4+-- V2 6 8+--+(*^) :: forall f a. (Functor f, A.Num a, Box f a)+     => Exp a+     -> Exp (f a)+     -> Exp (f a)+(*^) = lift2 ((L.*^) :: Exp a -> f (Exp a) -> f (Exp a))++-- | Compute the right scalar product+--+-- >>> V2 3 4 ^* 2+-- V2 6 8+--+(^*) :: forall f a. (Functor f, A.Num a, Box f a)+     => Exp (f a)+     -> Exp a+     -> Exp (f a)+(^*) = lift2 ((L.^*) :: f (Exp a) -> Exp a -> f (Exp a))++-- | Compute division by a scalar on the right+--+-- V2 4 6 ^/ 2+-- V2 2 3+--+(^/) :: forall f a. (Functor f, A.Fractional a, Box f a)+     => Exp (f a)+     -> Exp a+     -> Exp (f a)+(^/) = lift2 ((L.^/) :: f (Exp a) -> Exp a -> f (Exp a))++-- | Compute division of a scalar on the left+--+-- >>> 4 /^ V2 2 4+-- V2 2 1+--+(/^) :: forall f a. (Functor f, A.Fractional a, Box f a)+     => Exp a+     -> Exp (f a)+     -> Exp (f a)+(/^) = lift2 ((\a f -> fmap (a/) f) :: Exp a -> f (Exp a) -> f (Exp a))++-- | Addition with a scalar on the left+--+-- >>> 2 +^ V2 3 4+-- V2 5 4+--+(+^) :: forall f a. (Functor f, A.Num a, Box f a)+     => Exp a+     -> Exp (f a)+     -> Exp (f a)+(+^) = lift2 ((\a f -> fmap (+a) f) :: Exp a -> f (Exp a) -> f (Exp a))++-- | Addition with a scalar on the right+--+-- >>> V2 1 2 ^+ 3+-- V2 4 3+--+(^+) :: forall f a. (Functor f, A.Num a, Box f a)+     => Exp (f a)+     -> Exp a+     -> Exp (f a)+(^+) = lift2 ((\f a -> fmap (a+) f) :: f (Exp a) -> Exp a -> f (Exp a))++-- | Subtraction with a scalar on the left+--+-- >>> 2 -^ V2 3 4+-- V2 1 2+--+(-^) :: forall f a. (Functor f, A.Num a, Box f a)+     => Exp a+     -> Exp (f a)+     -> Exp (f a)+(-^) = lift2 ((\a f -> fmap (A.subtract a) f) :: Exp a -> f (Exp a) -> f (Exp a))++-- | Subtraction with a scalar on the right+--+-- >>> V2 1 2 ^- 3+-- V2 (-2) (-1)+--+(^-) :: forall f a. (Functor f, A.Num a, Box f a)+     => Exp (f a)+     -> Exp a+     -> Exp (f a)+(^-) = lift2 ((\f a -> fmap (a-) f) :: f (Exp a) -> Exp a -> f (Exp a))+
− src/Linear/Accelerate.hs 
@@ -1,294 +0,0 @@-{-# 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.Array.Accelerate.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)------------------------------------------------------------------------------------- * 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)--}
− travis/config 
@@ -1,16 +0,0 @@--- 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