linear-accelerate 0.6.0.0 → 0.7.0.0

raw patch · 26 files changed

+516/−615 lines, 26 filesdep ~acceleratedep ~linearPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: accelerate, linear

API changes (from Hackage documentation)

Files

• .travis.yml +0/−82
• .vim.custom +0/−21
• CHANGELOG.markdown +0/−60
• CHANGELOG.md +69/−0
• LICENSE +1/−1
• README.markdown +0/−15
• README.md +23/−0
• linear-accelerate.cabal +17/−17
• src/Data/Array/Accelerate/Linear.hs +2/−2
• src/Data/Array/Accelerate/Linear/Conjugate.hs +10/−7
• src/Data/Array/Accelerate/Linear/Epsilon.hs +6/−6
• src/Data/Array/Accelerate/Linear/Lift.hs +2/−2
• src/Data/Array/Accelerate/Linear/Matrix.hs +12/−13
• src/Data/Array/Accelerate/Linear/Metric.hs +7/−5
• src/Data/Array/Accelerate/Linear/Plucker.hs +43/−76
• src/Data/Array/Accelerate/Linear/Projection.hs +96/−0
• src/Data/Array/Accelerate/Linear/Quaternion.hs +92/−111
• src/Data/Array/Accelerate/Linear/Trace.hs +2/−2
• src/Data/Array/Accelerate/Linear/Type.hs +2/−2
• src/Data/Array/Accelerate/Linear/V0.hs +11/−20
• src/Data/Array/Accelerate/Linear/V1.hs +31/−41
• src/Data/Array/Accelerate/Linear/V2.hs +26/−37
• src/Data/Array/Accelerate/Linear/V3.hs +23/−36
• src/Data/Array/Accelerate/Linear/V4.hs +23/−42
• src/Data/Array/Accelerate/Linear/Vector.hs +17/−16
• tests/doctests.hs +1/−1

@@ -1,82 +0,0 @@-# vim: nospell-#-# Basic template to test with GHC=[7.8, 7.10, 8.0]. Caches the 'stack' build-# directory to speed subsequent compilations.-#-# https://docs.travis-ci.com/user/reference/overview/-#-language: minimal-dist: trusty-sudo: true      # more storage available on sudo-enabled instances--cache:-  directories:-    - $HOME/.stack/snapshots-    - .stack-work/install--before_cache:-  - rm -rf $(stack path --local-install-root)/doc--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.10.3 CABAL=1.24-      compiler: "GHC 7.10"-      addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, cabal-install-1.24 ] }}--    - 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=8.2.2 CABAL=2.0-      compiler: "GHC 8.2"-      addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, cabal-install-2.0 ] }}--    - env: GHC=8.4.1 CABAL=2.0-      compiler: "GHC 8.4"-      addons: { apt: { sources: [ *apt_sources ], packages: [ *apt_packages, cabal-install-2.0 ] }}--    # - 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:-  - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"-  - cabal --version-  - stack --version-  - stack build --no-terminal --dry-run-  - travis_retry travis_wait 60 stack build --fast --test --only-dependencies --no-terminal --no-copy-bins--script:-  - stack build --no-terminal --fast --test --haddock --no-haddock-deps --no-run-tests-  - stack test--after_success:-  - source .travis/update-accelerate-buildbot.sh--notifications:-  irc:-    channels:-      - "irc.freenode.org#haskell-lens"-    skip_join: true-    template:-      - "\x0313linear-accelerate\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"-

@@ -1,21 +0,0 @@-" 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"

@@ -1,60 +0,0 @@-# Change Log--Notable changes to the project will be documented in this file.--The format is based on [Keep a Changelog](http://keepachangelog.com/) and the-project adheres to the [Haskell Package Versioning Policy-(PVP)](https://pvp.haskell.org)--## [0.6.0.0] - 2018-04-03-### Changed-  * update for accelerate-1.2--### Fixed-  * Disambiguate uses of `fromInteger` and `fromRational`.--## [0.5.0.1] - 2017-09-29-### Fixed-  * doctest failure with accelerate-1.1.1.0 ([#10])--## [0.5] - 2017-08-06-### Fixed-  * "impossible evaluation" error with accelerate-llvm-native ([#25][acc-llvm#25])--## [0.4.1] - 2017-07-29-### Added-  * Support `doctest-0.12`.--## [0.4] - 2017-06-16-### Changed-  * Revamp `Setup.hs` to use `cabal-doctest`. This makes `linear-accelerate` build with `Cabal-2.0`.-  * Re-enable the `doctest`s.--### Fixed-  * Fix handedness of `(-^)` and `(^-)`.--## [0.3] - 2017-04-01-### Changed-  * Expanded API coverage--## [0.2] - 2014-09-15-### Fixed-  * Move `Data.Complex` instances into the `accelerate` package ([#1])--## [0.1] - 2014-03-28-  * Repository initialized---[0.6.0.0]:          https://github.com/ekmett/linear-accelerate/compare/v0.5.0.1...v0.6.0.0-[0.5.0.1]:          https://github.com/ekmett/linear-accelerate/compare/v0.5...v0.5.0.1-[0.5]:              https://github.com/ekmett/linear-accelerate/compare/v0.4.1...v0.5-[0.4.1]:            https://github.com/ekmett/linear-accelerate/compare/v0.4...v0.4.1-[0.4]:              https://github.com/ekmett/linear-accelerate/compare/v0.3...v0.4-[0.3]:              https://github.com/ekmett/linear-accelerate/compare/v0.2...v0.3-[0.2]:              https://github.com/ekmett/linear-accelerate/compare/v0.1...v0.2-[0.1]:              https://github.com/ekmett/linear-accelerate/compare/3db20f05af0a1488fcbc3ea28f8561ce73289b73...v0.1--[#1]:               https://github.com/ekmett/linear-accelerate/issues/1-[#10]:              https://github.com/ekmett/linear-accelerate/issues/10-[acc-llvm#25]:      https://github.com/AccelerateHS/accelerate-llvm/issues/25-

@@ -0,0 +1,69 @@+# Change Log++Notable changes to the project will be documented in this file.++The format is based on [Keep a Changelog](http://keepachangelog.com/) and the+project adheres to the [Haskell Package Versioning Policy+(PVP)](https://pvp.haskell.org)++## [0.7.0.0] - 2020-08-26+### Added+  * embedded pattern synonyms such as `V3_`, etc.++### Changed+  * Update for accelerate-1.3++## [0.6.0.0] - 2018-04-03+### Changed+  * update for accelerate-1.2++### Fixed+  * Disambiguate uses of `fromInteger` and `fromRational`.++## [0.5.0.1] - 2017-09-29+### Fixed+  * doctest failure with accelerate-1.1.1.0 ([#10])++## [0.5] - 2017-08-06+### Fixed+  * "impossible evaluation" error with accelerate-llvm-native ([#25][acc-llvm#25])++## [0.4.1] - 2017-07-29+### Added+  * Support `doctest-0.12`.++## [0.4] - 2017-06-16+### Changed+  * Revamp `Setup.hs` to use `cabal-doctest`. This makes `linear-accelerate` build with `Cabal-2.0`.+  * Re-enable the `doctest`s.++### Fixed+  * Fix handedness of `(-^)` and `(^-)`.++## [0.3] - 2017-04-01+### Changed+  * Rewritten by Trevor L. McDonell+  * Expanded API coverage++## [0.2] - 2014-09-15+### Fixed+  * Move `Data.Complex` instances into the `accelerate` package ([#1])++## [0.1] - 2014-03-28+  * Repository initialized+++[0.7.0.0]:          https://github.com/ekmett/linear-accelerate/compare/v0.6.0.0...v0.7.0.0+[0.6.0.0]:          https://github.com/ekmett/linear-accelerate/compare/v0.5.0.1...v0.6.0.0+[0.5.0.1]:          https://github.com/ekmett/linear-accelerate/compare/v0.5...v0.5.0.1+[0.5]:              https://github.com/ekmett/linear-accelerate/compare/v0.4.1...v0.5+[0.4.1]:            https://github.com/ekmett/linear-accelerate/compare/v0.4...v0.4.1+[0.4]:              https://github.com/ekmett/linear-accelerate/compare/v0.3...v0.4+[0.3]:              https://github.com/ekmett/linear-accelerate/compare/v0.2...v0.3+[0.2]:              https://github.com/ekmett/linear-accelerate/compare/v0.1...v0.2+[0.1]:              https://github.com/ekmett/linear-accelerate/compare/3db20f05af0a1488fcbc3ea28f8561ce73289b73...v0.1++[#1]:               https://github.com/ekmett/linear-accelerate/issues/1+[#10]:              https://github.com/ekmett/linear-accelerate/issues/10+[acc-llvm#25]:      https://github.com/AccelerateHS/accelerate-llvm/issues/25+

@@ -1,4 +1,4 @@-Copyright 2014 Edward Kmett, Charles Durham+Copyright 2014 Edward Kmett, Charles Durham, Trevor L. McDonell  All rights reserved. 

@@ -1,15 +0,0 @@-linear-accelerate-=================--[![Hackage](https://img.shields.io/hackage/v/linear-accelerate.svg)](https://hackage.haskell.org/package/linear-accelerate) [![Build Status](https://secure.travis-ci.org/ekmett/linear-accelerate.png?branch=master)](http://travis-ci.org/ekmett/linear-accelerate)--This package provides orphan instances that allows you to use `linear` vector spaces in `accelerate`.--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,23 @@+<div align="center">+<img width="450" src="https://github.com/AccelerateHS/accelerate/raw/master/images/accelerate-logo-text-v.png?raw=true" alt="henlo, my name is Theia"/>++# linear-accelerate++[![GitHub CI](https://github.com/tmcdonell/linear-accelerate/workflows/CI/badge.svg)](https://github.com/tmcdonell/linear-accelerate/actions)+[![Gitter](https://img.shields.io/gitter/room/nwjs/nw.js.svg)](https://gitter.im/AccelerateHS/Lobby)+<br>+[![Stackage LTS](https://stackage.org/package/linear-accelerate/badge/lts)](https://stackage.org/lts/package/linear-accelerate)+[![Stackage Nightly](https://stackage.org/package/linear-accelerate/badge/nightly)](https://stackage.org/nightly/package/linear-accelerate)+[![Hackage](https://img.shields.io/hackage/v/linear-accelerate.svg)](https://hackage.haskell.org/package/linear-accelerate)++</div>++Types and combinators to mix [linear][linear] with [accelerate][accelerate].++Contributions and bug reports are welcome!<br>+Please feel free to contact me through [GitHub][accelerate] or [gitter.im][gitter.im].++ [linear]:              https://github.com/ekmett/linear+ [accelerate]:          https://github.com/AccelerateHS/accelerate+ [gitter.im]:           https://gitter.im/AccelerateHS/Lobby+

@@ -1,33 +1,32 @@ name:          linear-accelerate-category:      Math, Algebra, Compilers/Interpreters, Concurrency, Data, Parallelism-version:       0.6.0.0+category:      Accelerate, Math, Algebra+version:       0.7.0.0 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE author:        Edward A. Kmett, Charles Durham, Trevor L. McDonell-maintainer:    Edward A. Kmett <ekmett@gmail.com>+maintainer:    Trevor L. McDonell <trevor.mcdonell@gmail.com> stability:     provisional-homepage:      http://github.com/ekmett/linear-accelerate/-bug-reports:   http://github.com/ekmett/linear-accelerate/issues+homepage:      http://github.com/tmcdonell/linear-accelerate/+bug-reports:   http://github.com/tmcdonell/linear-accelerate/issues copyright:     Copyright (C) 2014 Edward A. Kmett synopsis:      Lifting linear vector spaces into Accelerate-description:   Lifting linear vector spaces into Accelerate+description:   Please see the README on GitHub at <https://github.com/tmcdonell/linear-accelerate#readme> build-type:    Custom+ extra-source-files:-  .travis.yml-  .vim.custom-  CHANGELOG.markdown-  README.markdown+  CHANGELOG.md+  README.md   Warning.hs  source-repository head   type:     git-  location: git://github.com/ekmett/linear-accelerate.git+  location: git://github.com/tmcdonell/linear-accelerate.git  source-repository this   type:     git-  tag:      v0.6.0.0-  location: git://github.com/ekmett/linear-accelerate.git+  tag:      v0.7.0.0+  location: git://github.com/tmcdonell/linear-accelerate.git  custom-setup   setup-depends:@@ -38,20 +37,21 @@ library   build-depends:       base              >= 4.5          && < 5-    , accelerate        >= 1.2+    , accelerate        >= 1.3     , distributive      >= 0.2.2        && < 1     , lens              >= 4            && < 5-    , linear            >= 1.10         && < 2+    , linear            >= 1.15         && < 2    exposed-modules:     Data.Array.Accelerate.Linear     Data.Array.Accelerate.Linear.Conjugate     Data.Array.Accelerate.Linear.Epsilon     Data.Array.Accelerate.Linear.Matrix-    Data.Array.Accelerate.Linear.Trace     Data.Array.Accelerate.Linear.Metric     Data.Array.Accelerate.Linear.Plucker+    Data.Array.Accelerate.Linear.Projection     Data.Array.Accelerate.Linear.Quaternion+    Data.Array.Accelerate.Linear.Trace     Data.Array.Accelerate.Linear.Type     Data.Array.Accelerate.Linear.V0     Data.Array.Accelerate.Linear.V1@@ -81,7 +81,7 @@    build-depends:       base              == 4.*-    , doctest           >= 0.11.1 && < 0.16+    , doctest           >= 0.11.1 && < 0.17     , linear-accelerate    default-language:

@@ -2,10 +2,10 @@ -- | -- Module      : Data.Array.Accelerate.Linear -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --

@@ -1,15 +1,16 @@+{-# LANGUAGE MonoLocalBinds      #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE PatternSynonyms     #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns        #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Conjugate--- Copyright   : 2018 Trevor L. McDonell+-- Copyright   : [2018..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -24,7 +25,7 @@ ) where  import Data.Array.Accelerate                                        as A-import Data.Array.Accelerate.Data.Complex                           ( Complex(..) )+import Data.Array.Accelerate.Data.Complex                           ( pattern (::+),  Complex(..) )  import Linear.Conjugate @@ -38,13 +39,14 @@ instance Conjugate (Exp Word32) instance Conjugate (Exp Word16) instance Conjugate (Exp Word8)-instance Conjugate (Exp Double)+instance Conjugate (Exp Half) instance Conjugate (Exp Float)+instance Conjugate (Exp Double) instance Conjugate (Exp CFloat) instance Conjugate (Exp CDouble)  instance (Conjugate (Exp a), A.RealFloat a, Elt (Complex a)) => Conjugate (Exp (Complex a)) where-  conjugate (unlift -> a :+ b :: Complex (Exp a)) = lift $ conjugate a :+ negate b+  conjugate (a ::+ b) = conjugate a ::+ negate b  instance TrivialConjugate (Exp Int) instance TrivialConjugate (Exp Int64)@@ -56,8 +58,9 @@ instance TrivialConjugate (Exp Word32) instance TrivialConjugate (Exp Word16) instance TrivialConjugate (Exp Word8)-instance TrivialConjugate (Exp Double)+instance TrivialConjugate (Exp Half) instance TrivialConjugate (Exp Float)+instance TrivialConjugate (Exp Double) instance TrivialConjugate (Exp CFloat) instance TrivialConjugate (Exp CDouble) 

@@ -5,10 +5,10 @@ -- | -- Module      : Data.Array.Accelerate.Linear.Epsilon -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -24,16 +24,16 @@ -- | Provides a fairly subjective test to see if a quantity is near zero. -- -- >>> nearZero (1e-11 :: Exp Double)--- False+-- (0, ()) -- -- >>> nearZero (1e-17 :: Exp Double)--- True+-- (1, ()) -- -- >>> nearZero (1e-5 :: Exp Float)--- False+-- (0, ()) -- -- >>> nearZero (1e-7 :: Exp Float)--- True+-- (1, ()) -- class Num a => Epsilon a where   -- | Determine if a quantity is near zero.

@@ -5,10 +5,10 @@ ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Lift--- Copyright   : [2015..2018] Trevor L. McDonell+-- Copyright   : [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Trevor L. McDonell <tmcdonell@cse.unsw.edu.au>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --

@@ -1,15 +1,16 @@ {-# LANGUAGE ConstraintKinds     #-} {-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE PatternSynonyms     #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies        #-} ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Matrix -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -32,8 +33,7 @@  ) where -import Data.Array.Accelerate                    as A hiding ( transpose )-+import Data.Array.Accelerate                    as A hiding ( transpose, pattern V2, pattern V3, pattern V4 ) import Data.Array.Accelerate.Linear.Lift import Data.Array.Accelerate.Linear.Trace import Data.Array.Accelerate.Linear.Type@@ -64,7 +64,7 @@ infixl 7 !*! -- | Matrix product. This can compute any combination of sparse and dense multiplication. ----- >>> test $ lift (V2 (V3 1 2 3) (V3 4 5 6) :: M23 Int) !*! lift (V3 (V2 1 2) (V2 3 4) (V2 4 5) :: M32 Int)+-- >>> test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !*! (V3_ (V2_ 1 2) (V2_ 3 4) (V2_ 4 5) :: Exp (M32 Int)) -- V2 (V2 19 25) (V2 43 58) -- (!*!) :: (Functor m, Foldable t, Additive t, Additive n, A.Num a, Box2 m t a, Box2 t n a, Box2 m n a)@@ -77,7 +77,7 @@ infixl 6 !+! -- | Entry-wise matrix addition. ----- >>> test $ lift (V2 (V3 1 2 3) (V3 4 5 6) :: M23 Int) !+! lift (V2 (V3 7 8 9) (V3 1 2 3) :: M23 Int)+-- >>> test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !+! (V2_ (V3_ 7 8 9) (V3_ 1 2 3) :: Exp (M23 Int)) -- V2 (V3 8 10 12) (V3 5 7 9) -- (!+!) :: (Additive m, Additive n, A.Num a, Box2 m n a)@@ -90,7 +90,7 @@ infixl 6 !-! -- | Entry-wise matrix subtraction. ----- >>> test $ lift (V2 (V3 1 2 3) (V3 4 5 6) :: M23 Int) !-! lift (V2 (V3 7 8 9) (V3 1 2 3) :: M23 Int)+-- >>> test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !-! (V2_ (V3_ 7 8 9) (V3_ 1 2 3) :: Exp (M23 Int)) -- V2 (V3 (-6) (-6) (-6)) (V3 3 3 3) -- (!-!) :: (Additive m, Additive n, A.Num a, Box2 m n a)@@ -103,7 +103,7 @@ infixl 7 !* -- | Matrix * column vector ----- >>> test $ lift (V2 (V3 1 2 3) (V3 4 5 6) :: M23 Int) !* lift (V3 7 8 9 :: V3 Int)+-- >>> test $ (V2_ (V3_ 1 2 3) (V3_ 4 5 6) :: Exp (M23 Int)) !* (V3_ 7 8 9 :: Exp (V3 Int)) -- V2 50 122 -- (!*) :: (Functor m, Foldable r, Additive r, A.Num a, Box2 m r a, Box m a)@@ -116,7 +116,7 @@ infixl 7 *! -- | Row vector * matrix ----- >>> test $ lift (V2 1 2 :: V2 Int) *! lift (V2 (V3 3 4 5) (V3 6 7 8) :: M23 Int)+-- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) *! (V2_ (V3_ 3 4 5) (V3_ 6 7 8) :: Exp (M23 Int)) -- V3 15 18 21  -- (*!) :: (Metric r, Additive n, Num a) => r a -> r (n a) -> n a@@ -132,7 +132,7 @@ infixl 7 *!! -- | Scalar-matrix product ----- >>> test $ 5 *!! lift (V2 (V2 1 2) (V2 3 4) :: M22 Int)+-- >>> test $ 5 *!! (V2_ (V2_ 1 2) (V2_ 3 4) :: Exp (M22 Int)) -- V2 (V2 5 10) (V2 15 20) -- (*!!) :: (Functor m, Functor r, A.Num a, Box2 m r a)@@ -145,7 +145,7 @@ infixl 7 !!* -- | Matrix-scalar product ----- >>> test $ lift (V2 (V2 1 2) (V2 3 4) :: M22 Int) !!* 5+-- >>> test $ (V2_ (V2_ 1 2) (V2_ 3 4) :: Exp (M22 Int)) !!* 5 -- V2 (V2 5 10) (V2 15 20) -- (!!*) :: (Functor m, Functor r, A.Num a, Box2 m r a)@@ -179,7 +179,7 @@  -- | 'transpose' is just an alias for 'distribute' ----- >>> test $ transpose $ lift (V3 (V2 1 2) (V2 3 4) (V2 5 6) :: M32 Int)+-- >>> test $ transpose $ (V3_ (V2_ 1 2) (V2_ 3 4) (V2_ 5 6) :: Exp (M32 Int)) -- V2 (V3 1 3 5) (V3 2 4 6) -- transpose@@ -259,4 +259,3 @@ inv44 m =   let r = L.inv44 (unlift' m)   in  lift r-

@@ -1,16 +1,17 @@ {-# LANGUAGE ConstraintKinds     #-} {-# LANGUAGE FlexibleContexts    #-} {-# LANGUAGE NoImplicitPrelude   #-}+{-# LANGUAGE PatternSynonyms     #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies        #-} ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Metric -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -20,7 +21,7 @@ module Data.Array.Accelerate.Linear.Metric   where -import Data.Array.Accelerate                    as A+import Data.Array.Accelerate                    as A hiding ( pattern V2 ) import Data.Array.Accelerate.Linear.Type import Data.Array.Accelerate.Linear.Epsilon import Data.Array.Accelerate.Linear.Vector@@ -28,7 +29,8 @@ import qualified Linear.Metric                  as L  -- $setup--- >>> import Data.Array.Accelerate.Linear.V2 ()+-- >>> :set -XPatternSynonyms+-- >>> import Data.Array.Accelerate.Linear.V2 ( pattern V2_ ) -- >>> import Linear.V2  -- | Free and sparse inner product/metric spaces.@@ -38,7 +40,7 @@   -- | Compute the inner product of two vectors or (equivalently) convert a   -- vector @f a@ into a covector @f a -> a@.   ---  -- >>> lift (V2 1 2 :: V2 Int) `dot` lift (V2 3 4 :: V2 Int)+  -- >>> (V2_ 1 2 :: Exp (V2 Int)) `dot` (V2_ 3 4 :: Exp (V2 Int))   -- 11   --   dot :: forall a. (A.Num a, Box f a)

@@ -2,10 +2,14 @@ {-# LANGUAGE DeriveDataTypeable    #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE GADTs                 #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# LANGUAGE RebindableSyntax      #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE StandaloneDeriving    #-}+{-# LANGUAGE TemplateHaskell       #-}+{-# LANGUAGE TypeApplications      #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE UndecidableInstances  #-} {-# LANGUAGE ViewPatterns          #-}@@ -15,10 +19,10 @@ -- | -- Module      : Data.Array.Accelerate.Linear.Plucker -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -27,7 +31,7 @@  module Data.Array.Accelerate.Linear.Plucker ( -  Plucker(..),+  Plucker(..), pattern Plucker_,    squaredError,   isotropic,@@ -36,7 +40,7 @@   plucker3D,    -- * operations on lines-  LinePass(..),+  LinePass(..), pattern Clockwise_, pattern Counterclockwise_, pattern Coplanar_,   parallel,   intersects,   passes,@@ -52,11 +56,10 @@  ) where -import Data.Array.Accelerate                    hiding ( fromInteger )+import Data.Array.Accelerate                    hiding ( fromInteger, pattern V2, pattern V3, pattern V4 ) import Data.Array.Accelerate.Data.Functor import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate.Unsafe  import Data.Array.Accelerate.Linear.Epsilon import Data.Array.Accelerate.Linear.Lift@@ -123,47 +126,47 @@   if s > 0      then constant Counterclockwise                 else constant Clockwise   where-    s        = (lift u1 `dot` lift v2) + (lift u2 `dot` lift v1)-    V2 u1 v1 = toUV a-    V2 u2 v2 = toUV b+    s        = (u1 `dot` v2) + (u2 `dot` v1)+    V2_ u1 v1 = toUV a+    V2_ u2 v2 = toUV b  -- | Checks if two lines are parallel. -- parallel :: Epsilon a => Exp (Plucker a) -> Exp (Plucker a) -> Exp Bool-parallel a b = nearZero $ lift u1 `cross` lift u2+parallel a b = nearZero $ u1 `cross` u2   where-    V2 u1 _ = toUV a-    V2 u2 _ = toUV b+    V2_ u1 _ = toUV a+    V2_ u2 _ = toUV b  -- | Represent a Plücker coordinate as a pair of 3-tuples, typically denoted -- U and V. ---toUV :: Elt a => Exp (Plucker a) -> V2 (V3 (Exp a))-toUV (unlift -> Plucker a b c d e f) = V2 (V3 a b c) (V3 d e f)+toUV :: Elt a => Exp (Plucker a) -> Exp (V2 (V3 a))+toUV (Plucker_ a b c d e f) = V2_ (V3_ a b c) (V3_ d e f)  -- | The minimum squared distance of a line from the origin. -- quadranceToOrigin :: Fractional a => Exp (Plucker a) -> Exp a-quadranceToOrigin p = (lift v `dot` lift v) / (lift u `dot` lift u)+quadranceToOrigin p = (v `dot` v) / (u `dot` u)   where-    V2 u v = toUV p+    V2_ u v = toUV p  -- | The point where a line is closest to the origin. -- closestToOrigin :: Fractional a => Exp (Plucker a) -> Exp (V3 a)-closestToOrigin p = normalizePoint . lift $ V4 x y z (lift u `dot` lift u)+closestToOrigin p = normalizePoint $ V4_ x y z (u `dot` u)   where-    V2 u v   = toUV p-    V3 x y z = unlift $ lift v `cross` lift u+    V2_ u v   = toUV p+    V3_ x y z = v `cross` u  -- | Not all 6-dimensional points correspond to a line in 3D. This predicate -- tests that a Plücker coordinate lies on the Grassmann manifold, and does -- indeed represent a 3D line. -- isLine :: Epsilon a => Exp (Plucker a) -> Exp Bool-isLine p = nearZero $ lift u `dot` lift v+isLine p = nearZero $ u `dot` v   where-    V2 u v = toUV p+    V2_ u v = toUV p   -- | These elements form a basis for the Plücker space, or the Grassmanian@@ -215,44 +218,21 @@  deriving instance Typeable Plucker +pattern Plucker_ :: Elt a => Exp a -> Exp a -> Exp a -> Exp a -> Exp a -> Exp a -> Exp (Plucker a)+pattern Plucker_ a b c d e f = Pattern (a,b,c,d,e,f)+{-# COMPLETE 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 Elt a => Elt (Plucker 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+    Plucker_ (lift x) (lift y) (lift z) (lift w) (lift u) (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)+  unlift (Plucker_ x y z w u v) = Plucker x y z w u v  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))@@ -269,11 +249,11 @@   min  = pl $$ on min t6   max  = pl $$ on max t6 -t6 :: Elt a => Exp (Plucker a) -> Exp (a,a,a,a,a,a)-t6 (unlift -> Plucker a b c d e f) = tup6 (a,b,c,d,e,f)+t6 :: Exp (Plucker a) -> Exp (a, a, a, a, a, a)+t6 (Exp e) = Exp e -pl :: Elt a => Exp (a,a,a,a,a,a) -> Exp (Plucker a)-pl (untup6 -> (a,b,c,d,e,f)) = lift (Plucker a b c d e f)+pl :: Exp (a, a, a, a, a, a) -> Exp (Plucker a)+pl (Exp e) = Exp e  instance Num a => P.Num (Exp (Plucker a)) where   (+)           = lift2 ((+) :: Plucker (Exp a) -> Plucker (Exp a) -> Plucker (Exp a))@@ -313,27 +293,14 @@   nearZero = nearZero . quadrance  instance Functor Plucker where-  fmap g (unlift -> Plucker a b c d e f) = lift (Plucker (g a) (g b) (g c) (g d) (g e) (g f))-  x <$ _                                 = lift (Plucker x x x x x x)---type instance EltRepr LinePass = Int8--instance Elt LinePass where-  eltType _ = eltType (undefined::Int8)--  toElt x = let (==) = (P.==)   -- -XRebindableSyntax hax-            in  case x of-                  0 -> Coplanar-                  1 -> Clockwise-                  2 -> Counterclockwise-                  _ -> P.error "LinePass: unhandled constructor"+  fmap g (Plucker_ a b c d e f) = Plucker_ (g a) (g b) (g c) (g d) (g e) (g f)+  x <$ _                        = Plucker_ x x x x x x -  fromElt Coplanar         = 0-  fromElt Clockwise        = 1-  fromElt Counterclockwise = 2+instance Elt LinePass  instance Eq LinePass where-  x == y = bitcast x == (bitcast y :: Exp Int8)-  x /= y = bitcast x /= (bitcast y :: Exp Int8)+  x == y = coerce x == (coerce y :: Exp Word8)+  x /= y = coerce x /= (coerce y :: Exp Word8)++mkPattern ''LinePass 

@@ -0,0 +1,96 @@+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PatternSynonyms  #-}+-----------------------------------------------------------------------------+-- |+-- Module      : Data.Array.Accelerate.Linear.Projection+-- Copyright   : [2019..2020] Trevor L. McDonell+-- License     : BSD-style (see the file LICENSE)+--+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com>+-- Stability   : experimental+-- Portability : non-portable+--+-- Common projection matrices; for example perspective and orthographic+-- transformation matrices.+--+-- @since 0.7.0.0+----------------------------------------------------------------------------++module Data.Array.Accelerate.Linear.Projection+  where++import Data.Array.Accelerate                              hiding ( pattern V3, pattern V4 )+import Data.Array.Accelerate.Smart+import Data.Array.Accelerate.Linear.Epsilon+import Data.Array.Accelerate.Linear.Matrix+import Data.Array.Accelerate.Linear.Metric+import Data.Array.Accelerate.Linear.V3+import Data.Array.Accelerate.Linear.V4++import Control.Lens+import qualified Linear.Projection                        as L+++-- | Build a look at view matrix+--+lookAt+  :: (Epsilon a, Floating a)+  => Exp (V3 a)     -- ^ Eye+  -> Exp (V3 a)     -- ^ Center+  -> Exp (V3 a)     -- ^ Up+  -> Exp (M44 a)+lookAt eye center up = V4_ (V4_ (xa ^. _x)  (xa ^. _y)  (xa ^. _z)  xd)+                           (V4_ (ya ^. _x)  (ya ^. _y)  (ya ^. _z)  yd)+                           (V4_ (-za ^. _x) (-za ^. _y) (-za ^. _z) zd)+                           (V4_ 0           0           0           1)+ where+  za = normalize $ center - eye+  xa = normalize $ cross za up+  ya = cross xa za+  xd = -dot xa eye+  yd = -dot ya eye+  zd = dot za eye+++-- | Build a matrix for a symmetric perspective-view frustum+--+perspective+  :: Floating a+  => Exp a -- ^ FOV+  -> Exp a -- ^ Aspect ratio+  -> Exp a -- ^ Near plane+  -> Exp a -- ^ Far plane+  -> Exp (M44 a)+perspective = lift $$$$ L.perspective+++-- | Build a matrix for a symmetric perspective-view frustum with a far+-- plane at infinite+--+infinitePerspective+  :: Floating a+  => Exp a -- ^ FOV+  -> Exp a -- ^ Aspect Ratio+  -> Exp a -- ^ Near plane+  -> Exp (M44 a)+infinitePerspective = lift $$$ L.infinitePerspective+++-- | Build an orthographic perspective matrix from 6 clipping planes+--+ortho+  :: Floating a+  => Exp a -- ^ Left+  -> Exp a -- ^ Right+  -> Exp a -- ^ Bottom+  -> Exp a -- ^ Top+  -> Exp a -- ^ Near+  -> Exp a -- ^ Far+  -> Exp (M44 a)+ortho = lift $$$$$$ L.ortho++infixr 0 $$$$$$+($$$$$$) :: (b -> a) -> (c -> d -> e -> f -> g -> h -> b) -> c -> d -> e -> f -> g -> h -> a+(f $$$$$$ g) x y z u v w = f (g x y z u v w)+

@@ -2,20 +2,20 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# LANGUAGE RebindableSyntax      #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-} {-# LANGUAGE UndecidableInstances  #-}-{-# LANGUAGE ViewPatterns          #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Quaternion -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -24,7 +24,7 @@  module Data.Array.Accelerate.Linear.Quaternion ( -  Quaternion(..),+  Quaternion(..), pattern Quaternion_,    slerp,   asinq,@@ -40,11 +40,9 @@  ) where -import Data.Array.Accelerate-import Data.Array.Accelerate.Array.Sugar+import Data.Array.Accelerate                    hiding ( pattern V3 ) import Data.Array.Accelerate.Data.Complex       hiding ( conjugate ) import Data.Array.Accelerate.Data.Functor-import Data.Array.Accelerate.Product import Data.Array.Accelerate.Smart  import Data.Array.Accelerate.Linear.Conjugate@@ -70,66 +68,66 @@   where     dqp = dot q p     phi = acos cosphi-    (cosphi, fp) = unlift $ if dqp < 0 then tup2 (-dqp, negate p)-                                       else tup2 (dqp, p)+    T2 cosphi fp = if dqp < 0 then T2 (negate dqp) (negate p)+                              else T2 dqp p  -- | 'asin' with a specified branch cut -- asinq :: (RealFloat a, Elt (Complex a)) => Exp (Quaternion a) -> Exp (Quaternion a) -> Exp (Quaternion a)-asinq q@(unlift -> Quaternion e _) u =+asinq q@(Quaternion_ e _) u =   if qiq /= 0.0 || e >= -1 && e <= 1     then asin q-    else cutWith (asin (lift $ e :+ sqrt qiq)) u+    else cutWith (asin (e ::+ sqrt qiq)) u   where     qiq = qi q  -- | 'acos' with a specified branch cut -- acosq :: (RealFloat a, Elt (Complex a)) => Exp (Quaternion a) -> Exp (Quaternion a) -> Exp (Quaternion a)-acosq q@(unlift -> Quaternion e _) u =+acosq q@(Quaternion_ e _) u =   if qiq /= 0.0 || e >= -1 && e <= 1     then acos q-    else cutWith (acos (lift $ e :+ sqrt qiq)) u+    else cutWith (acos (e ::+ sqrt qiq)) u   where     qiq = qi q  -- | 'atan' with a specified branch cut -- atanq :: (RealFloat a, Elt (Complex a)) => Exp (Quaternion a) -> Exp (Quaternion a) -> Exp (Quaternion a)-atanq q@(unlift -> Quaternion e _) u =+atanq q@(Quaternion_ e _) u =   if e /= 0.0 || qiq >= -1 && qiq <= 1     then atan q-    else cutWith (atan (lift $ e :+ sqrt qiq)) u+    else cutWith (atan (e ::+ sqrt qiq)) u   where     qiq = qi q  -- | 'asinh' with a specified branch cut -- asinhq :: (RealFloat a, Elt (Complex a)) => Exp (Quaternion a) -> Exp (Quaternion a) -> Exp (Quaternion a)-asinhq q@(unlift -> Quaternion e _) u =+asinhq q@(Quaternion_ e _) u =   if e /= 0.0 || qiq >= -1 && qiq <= 1     then asinh q-    else cutWith (asinh (lift $ e :+ sqrt qiq)) u+    else cutWith (asinh (e ::+ sqrt qiq)) u   where     qiq = qi q  -- | 'acosh' with a specified branch cut -- acoshq :: (RealFloat a, Elt (Complex a)) => Exp (Quaternion a) -> Exp (Quaternion a) -> Exp (Quaternion a)-acoshq q@(unlift -> Quaternion e _) u =+acoshq q@(Quaternion_ e _) u =   if qiq /= 0.0 || e >= 1     then asinh q-    else cutWith (acosh (lift $ e :+ sqrt qiq)) u+    else cutWith (acosh (e ::+ sqrt qiq)) u   where     qiq = qi q  -- | 'atanh' with a specified branch cut -- atanhq :: (RealFloat a, Elt (Complex a)) => Exp (Quaternion a) -> Exp (Quaternion a) -> Exp (Quaternion a)-atanhq q@(unlift -> Quaternion e _) u =+atanhq q@(Quaternion_ e _) u =   if qiq /= 0.0 || e > -1 && e < 1     then atanh q-    else cutWith (atanh (lift $ e :+ sqrt qiq)) u+    else cutWith (atanh (e ::+ sqrt qiq)) u   where     qiq = qi q @@ -146,15 +144,15 @@ -- | Apply a rotation to a vector -- rotate :: forall a. (Conjugate (Exp a), RealFloat a) => Exp (Quaternion a) -> Exp (V3 a) -> Exp (V3 a)-rotate q v = lift ijk+rotate q v = ijk   where-    Quaternion _ ijk = unlift $ q * (lift (Quaternion 0 (unlift v))) * conjugate q :: Quaternion (Exp a)+    Quaternion_ _ ijk = q * (Quaternion_ 0 v) * conjugate q  -- | @'axisAngle' axis theta@ builds a 'Quaternion' representing a rotation of -- @theta@ radians about @axis@. -- axisAngle :: (Epsilon a, Floating a) => Exp (V3 a) -> Exp a -> Exp (Quaternion a)-axisAngle axis theta = lift $ Quaternion (cos half) (unlift (sin half *^ normalize axis))+axisAngle axis theta = Quaternion_ (cos half) (sin half *^ normalize axis)   where     half = theta / 2 @@ -162,38 +160,20 @@ -- Instances -- --------- +pattern Quaternion_ :: Elt a => Exp a -> Exp (V3 a) -> Exp (Quaternion a)+pattern Quaternion_ x v = Pattern (x,v)+{-# COMPLETE Quaternion_ #-}+ 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 Elt a => Elt (Quaternion 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+  lift (Quaternion x v) = Quaternion_ (lift x) (lift v)  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))+  unlift (Quaternion_ x v) = Quaternion x (unlift v)  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))@@ -211,32 +191,32 @@   max  = qu $$ on max t4  t4 :: Elt a => Exp (Quaternion a) -> Exp (a,a,a,a)-t4 (unlift -> Quaternion x (V3 y z w)) = tup4 (x,y,z,w)+t4 (Quaternion_ x (V3_ y z w)) = T4 x y z w  qu :: Elt a => Exp (a,a,a,a) -> Exp (Quaternion a)-qu (untup4 -> (x,y,z,w)) = lift (Quaternion x (V3 y z w))+qu (T4 x y z w) = Quaternion_ x (V3_ y z w)  instance RealFloat a => P.Num (Exp (Quaternion a)) where   (+)           = lift2 ((+) :: Quaternion (Exp a) -> Quaternion (Exp a) -> Quaternion (Exp a))   (-)           = lift2 ((-) :: Quaternion (Exp a) -> Quaternion (Exp a) -> Quaternion (Exp a))   negate        = fmap negate-  abs z         = lift (Quaternion (norm z) (V3 0 0 0))-  fromInteger x = lift (Quaternion (fromInteger x) (V3 0 0 0))+  abs z         = Quaternion_ (norm z) (V3_ 0 0 0)+  fromInteger x = Quaternion_ (fromInteger x) (V3_ 0 0 0) -  z1 * z2       = let Quaternion s1 v1' = unlift z1; v1 = lift v1'-                      Quaternion s2 v2' = unlift z2; v2 = lift v2'-                  in-                  lift $ Quaternion (s1*s2 - (v1 `dot` v2))-                                    (unlift ((v1 `cross` v2) + s1*^v2 + s2*^v1))+  z1 * z2       = let Quaternion_ s1 v1 = z1+                      Quaternion_ s2 v2 = z2+                   in+                   Quaternion_ (s1*s2 - (v1 `dot` v2))+                               ((v1 `cross` v2) + s1*^v2 + s2*^v1) -  signum q@(unlift -> Quaternion e (V3 i j k)) =+  signum q@(Quaternion_ e (V3_ i j k)) =     if m == 0.0                      then q else     if not (isInfinite m || isNaN m) then q ^/ sqrt m else     if ne || ni || nj || nk          then qNaN else-    if not (ii || ij || ik)          then lift $ Quaternion 1 (V3 0 0 0) else-    if not (ie || ij || ik)          then lift $ Quaternion 0 (V3 1 0 0) else-    if not (ie || ii || ik)          then lift $ Quaternion 0 (V3 0 1 0) else-    if not (ie || ii || ij)          then lift $ Quaternion 0 (V3 0 0 1)+    if not (ii || ij || ik)          then Quaternion_ 1 (V3_ 0 0 0) else+    if not (ie || ij || ik)          then Quaternion_ 0 (V3_ 1 0 0) else+    if not (ie || ii || ik)          then Quaternion_ 0 (V3_ 0 1 0) else+    if not (ie || ii || ij)          then Quaternion_ 0 (V3_ 0 0 1)                                      else qNaN     where       m  = quadrance q@@ -249,42 +229,44 @@       nj = isNaN j       nk = isNaN k       ---      qNaN = lift $ Quaternion fNaN (V3 fNaN fNaN fNaN)+      qNaN = Quaternion_ fNaN (V3_ fNaN fNaN fNaN)       fNaN = 0/0  instance RealFloat a => P.Fractional (Exp (Quaternion a)) where   z1 / z2 =-    let Quaternion q0 (V3 q1 q2 q3) = unlift z1-        Quaternion r0 (V3 r1 r2 r3) = unlift z2+    let Quaternion_ q0 (V3_ q1 q2 q3) = z1+        Quaternion_ r0 (V3_ r1 r2 r3) = z2     in-    lift (Quaternion (r0*q0+r1*q1+r2*q2+r3*q3)-                     (V3 (r0*q1-r1*q0-r2*q3+r3*q2)-                         (r0*q2+r1*q3-r2*q0-r3*q1)-                         (r0*q3-r1*q2+r2*q1-r3*q0)))-      ^/ (r0*r0 + r1*r1 + r2*r2 + r3*r3)+    Quaternion_+        (r0 * q0 + r1 * q1 + r2 * q2 + r3 * q3)+        (V3_ (r0 * q1 - r1 * q0 - r2 * q3 + r3 * q2)+             (r0 * q2 + r1 * q3 - r2 * q0 - r3 * q1)+             (r0 * q3 - r1 * q2 + r2 * q1 - r3 * q0)+        )+      ^/ (r0 * r0 + r1 * r1 + r2 * r2 + r3 * r3) -  recip q = let Quaternion e v = unlift q :: Quaternion (Exp a)-            in  lift (Quaternion e (P.fmap negate v)) ^/ quadrance q+  recip q = let Quaternion_ e v = q+             in Quaternion_ e (fmap negate v) ^/ quadrance q -  fromRational x = lift (Quaternion (fromRational x) (V3 0 0 0))+  fromRational x = Quaternion_ (fromRational x) (V3_ 0 0 0)  instance (RealFloat a, Elt (Complex a)) => P.Floating (Exp (Quaternion a)) where-  pi = lift (Quaternion pi (V3 0 0 0))+  pi = Quaternion_ pi (V3_ 0 0 0) -  exp q@(unlift -> Quaternion e v) =+  exp q@(Quaternion_ e v) =     if qiq == 0-      then lift (Quaternion exe v)+      then Quaternion_ exe v       else reimagine (exe * cos ai) (exe * (sin ai / ai)) q     where       qiq = qi q       ai  = sqrt qiq       exe = exp e -  log q@(unlift -> Quaternion e v@(V3 _i j k)) =+  log q@(Quaternion_ e v@(V3_ _i j k)) =     if qiq == 0       then if e >= 0-             then lift $ Quaternion (log e) v-             else lift $ Quaternion (log (negate e)) (V3 pi j k) -- mmm, pi+             then Quaternion_ (log e) v+             else Quaternion_ (log (negate e)) (V3_ pi j k) -- mmm, pi       else reimagine (log m) (atan2 m e / ai) q     where       qiq = qi q@@ -293,34 +275,34 @@    x ** y = exp (y * log x) -  sqrt q@(unlift -> Quaternion e v) =+  sqrt q@(Quaternion_ e v) =     if m   == 0 then q else     if qiq == 0 then if e > 0-                        then lift $ Quaternion (sqrt e) (V3 0 0 0)-                        else lift $ Quaternion 0 (V3 (sqrt (negate e)) 0 0)-                else lift $ Quaternion (0.5*(m+e)) (unlift (lift v ^* im))+                        then Quaternion_ (sqrt e) (V3_ 0 0 0)+                        else Quaternion_ 0 (V3_ (sqrt (negate e)) 0 0)+                else Quaternion_ (0.5*(m+e)) (v ^* im)     where       qiq = qi q       im  = sqrt (0.5*(m-e)) / sqrt qiq       m   = sqrte2pqiq e qiq -  cos q@(unlift -> Quaternion e v) =-    if qiq == 0 then lift $ Quaternion (cos e) v+  cos q@(Quaternion_ e v) =+    if qiq == 0 then Quaternion_ (cos e) v                 else reimagine (cos e * cosh ai) (- sin e / ai / sinh ai) q -- 0.15 bits error                   -- reimagine (cos e * cosh ai) (- sin e * sinh ai / ai) q -- 13.5 bits worse     where       qiq = qi q       ai  = sqrt qiq -  sin q@(unlift -> Quaternion e v) =-    if qiq == 0 then lift $ Quaternion (sin e) v+  sin q@(Quaternion_ e v) =+    if qiq == 0 then Quaternion_ (sin e) v                 else reimagine (sin e * cosh ai) (cos e * sinh ai / ai) q     where       qiq = qi q       ai  = sqrt qiq -  tan q@(unlift -> Quaternion e v) =-    if qiq == 0 then lift $ Quaternion (tan e) v+  tan q@(Quaternion_ e v) =+    if qiq == 0 then Quaternion_ (tan e) v                 else reimagine (ce * sin e / d) (tanrhs sai ai d) q     where       qiq = qi q@@ -329,22 +311,22 @@       sai = sinh ai       d   = ce*ce + sai*sai -  sinh q@(unlift -> Quaternion e v) =-    if qiq == 0 then lift $ Quaternion (sinh e) v+  sinh q@(Quaternion_ e v) =+    if qiq == 0 then Quaternion_ (sinh e) v                 else reimagine (sinh e * cos ai) (cosh e * sin ai / ai) q     where       qiq = qi q       ai  = sqrt qiq -  cosh q@(unlift -> Quaternion e v) =-    if qiq == 0 then lift $ Quaternion (cosh e) v+  cosh q@(Quaternion_ e v) =+    if qiq == 0 then Quaternion_ (cosh e) v                 else reimagine (cosh e * cos ai) (sin ai * (sinh e / ai)) q     where       qiq = qi q       ai  = sqrt qiq -  tanh q@(unlift -> Quaternion e v) =-    if qiq == 0 then lift $ Quaternion (tanh e) v+  tanh q@(Quaternion_ e v) =+    if qiq == 0 then Quaternion_ (tanh e) v                 else reimagine (cosh e * se / d) (tanhrhs cai ai d) q     where       qiq = qi q@@ -363,31 +345,31 @@   reimagine :: RealFloat a => Exp a -> Exp a -> Exp (Quaternion a) -> Exp (Quaternion a)-reimagine r s (unlift -> Quaternion _ v) =+reimagine r s (Quaternion_ _ v) =   if isNaN s || isInfinite s     then let aux x = if x == 0 then 0                                else s * x-         in lift $ Quaternion r (P.fmap aux v)-    else    lift $ Quaternion r (unlift (lift v ^* s))+         in Quaternion_ r (fmap aux v)+    else    Quaternion_ r (v ^* s)  -- | Helper for calculating with specific branch cuts -- cut :: (RealFloat a, Elt (Complex a)) => (Exp (Complex a) -> Exp (Complex a)) -> Exp (Quaternion a) -> Exp (Quaternion a)-cut f q@(unlift -> Quaternion e (V3 _ y z)) =-  if qiq == 0 then lift $ Quaternion a (V3 b y z)+cut f q@(Quaternion_ e (V3_ _ y z)) =+  if qiq == 0 then Quaternion_ a (V3_ b y z)               else reimagine a (b / ai) q   where-    qiq    = qi q-    ai     = sqrt qiq-    a :+ b = unlift $ f (lift (e :+ ai))+    qiq     = qi q+    ai      = sqrt qiq+    a ::+ b = f (e ::+ ai)  -- | Helper for calculating with specific branch cuts -- cutWith :: (RealFloat a, Elt (Complex a)) => Exp (Complex a) -> Exp (Quaternion a) -> Exp (Quaternion a)-cutWith (unlift -> r :+ im) q@(unlift -> Quaternion e v) =+cutWith (r ::+ im) q@(Quaternion_ e v) =   if e /= 0 || qiq == 0 || isNaN qiq || isInfinite qiq     then 0/0 -- error "bad cut"  -- TLM: argh-    else lift $ Quaternion r (unlift (lift v ^* s))+    else Quaternion_ r (v ^* s)   where     qiq = qi q     s   = im / sqrt qiq@@ -395,7 +377,7 @@ -- | quadrance of the imaginary component -- qi :: Num a => Exp (Quaternion a) -> Exp a-qi (unlift -> Quaternion _ v :: Quaternion (Exp a)) = quadrance (lift v)+qi (Quaternion_ _ v) = quadrance v  sqrte2pqiq :: (Floating a, Ord a) => Exp a -> Exp a -> Exp a sqrte2pqiq e qiq = -- = sqrt (e*e) + qiq@@ -419,10 +401,9 @@   nearZero = nearZero . quadrance  instance (RealFloat a, Conjugate (Exp a)) => Conjugate (Exp (Quaternion a)) where-  conjugate (unlift -> Quaternion e v :: Quaternion (Exp a)) =-    lift (Quaternion (conjugate e) (unlift (negate (lift v :: Exp (V3 a)))))+  conjugate (Quaternion_ e v) = (Quaternion_ (conjugate e) (negate v))  instance Functor Quaternion where-  fmap f (unlift -> Quaternion e v) = lift (Quaternion (f e) (P.fmap f v))-  x <$ _                            = lift (Quaternion x (V3 x x x))+  fmap f (Quaternion_ e v) = Quaternion_ (f e) (fmap f v)+  x <$ _                   = Quaternion_ x (V3_ x x x) 

@@ -5,10 +5,10 @@ -- | -- Module      : Data.Array.Accelerate.Linear.Trace -- Copyright   : 2014 Edward Kmett---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --

@@ -4,10 +4,10 @@ ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Type--- Copyright   : [2015..2018] Trevor L. McDonell+-- Copyright   : [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable ----------------------------------------------------------------------------

@@ -1,18 +1,19 @@ {-# LANGUAGE ConstraintKinds       #-}+{-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# LANGUAGE ScopedTypeVariables   #-} {-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE UndecidableInstances  #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.V0 -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -21,15 +22,13 @@  module Data.Array.Accelerate.Linear.V0 ( -  V0(..),+  V0(..), pattern V0_,  ) where  import Data.Array.Accelerate                    as A import Data.Array.Accelerate.Data.Functor       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@@ -43,25 +42,17 @@ -- Instances -- --------- +pattern V0_ :: Elt a => Exp (V0 a)+pattern V0_ = Pattern ()+{-# COMPLETE V0_ #-}+ 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 Elt a => Elt (V0 a)  instance Lift Exp (V0 a) where   type Plain (V0 a) = ()-  lift V0 = Exp (Tuple NilTup)+  lift _ = Exp (SmartExp Nil)  instance Unlift Exp (V0 a) where   unlift _ = V0

@@ -2,19 +2,19 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# 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..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -23,16 +23,14 @@  module Data.Array.Accelerate.Linear.V1 ( -  V1(..), R1(..), ex,+  V1(..), pattern V1_,+  R1(..),+  ex,  ) where  import Data.Array.Accelerate                    as A import Data.Array.Accelerate.Data.Functor       as A-import Data.Array.Accelerate.Array.Sugar-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Type  import Data.Array.Accelerate.Linear.Epsilon import Data.Array.Accelerate.Linear.Lift@@ -57,10 +55,10 @@ -- class L.R1 t => R1 t where   -- |-  -- >>> test $ lift (V1 2 :: V1 Int) ^._x+  -- >>> test $ (V1_ 2 :: Exp (V1 Int)) ^. _x   -- 2   ---  -- >>> test $ lift (V1 2 :: V1 Int) & _x .~ 3+  -- >>> test $ (V1_ 2 :: Exp (V1 Int)) & _x .~ 3   -- V1 3   --   _x :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)@@ -74,48 +72,40 @@ -- Instances -- --------- +pattern V1_ :: Elt a => Exp a -> Exp (V1 a)+pattern V1_ x = Pattern x+{-# COMPLETE V1_ #-}+ instance Metric V1 instance Additive V1 instance R1 V1--type instance EltRepr (V1 a) = ((), EltRepr a)--instance Elt a => Elt (V1 a) where-  eltType _ = TypeRpair TypeRunit (eltType (undefined :: a))-  toElt ((), x) = V1 (toElt x)-  fromElt (V1 x) = ((), fromElt x)--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 Elt a => Elt (V1 a)  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+  lift (V1 x) = V1_ (lift x)  instance Elt a => Unlift Exp (V1 (Exp a)) where-  unlift t = V1 $ Exp $ ZeroTupIdx `Prj` t+  unlift (V1_ x) = V1 x  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))  instance A.Eq a => A.Eq (V1 a) where-  (unlift -> V1 x) == (unlift -> V1 y) = x A.== y-  (unlift -> V1 x) /= (unlift -> V1 y) = x A./= y+  V1_ x == V1_ y = x A.== y+  V1_ x /= V1_ y = x A./= y  instance A.Ord a => A.Ord (V1 a) where-  (unlift -> V1 x) <  (unlift -> V1 y) = x A.< y-  (unlift -> V1 x) >  (unlift -> V1 y) = x A.> y-  (unlift -> V1 x) >= (unlift -> V1 y) = x A.>= y-  (unlift -> V1 x) <= (unlift -> V1 y) = x A.<= y-  min (unlift -> V1 x) (unlift -> V1 y) = lift $ V1 (A.min x y)-  max (unlift -> V1 x) (unlift -> V1 y) = lift $ V1 (A.max x y)+  V1_ x <  V1_ y = x A.< y+  V1_ x >  V1_ y = x A.> y+  V1_ x >= V1_ y = x A.>= y+  V1_ x <= V1_ y = x A.<= y+  min (V1_ x) (V1_ y) = V1_ (A.min x y)+  max (V1_ x) (V1_ y) = V1_ (A.max x y)  instance A.Bounded a => P.Bounded (Exp (V1 a)) where-  minBound = lift (V1 (minBound :: Exp a))-  maxBound = lift (V1 (maxBound :: Exp a))+  minBound = V1_ minBound+  maxBound = V1_ maxBound  instance A.Num a => P.Num (Exp (V1 a)) where   (+)             = lift2 ((+) :: V1 (Exp a) -> V1 (Exp a) -> V1 (Exp a))@@ -124,15 +114,15 @@   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 (P.fromInteger x :: V1 (Exp a))+  fromInteger x   = V1_ (P.fromInteger x)  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 (P.fromRational x :: V1 (Exp a))+  fromRational x  = V1_ (P.fromRational x)  instance A.Floating a => P.Floating (Exp (V1 a)) where-  pi              = lift (pi :: V1 (Exp a))+  pi              = V1_ pi   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))@@ -149,9 +139,9 @@   atanh           = lift1 (atanh :: V1 (Exp a) -> V1 (Exp a))  instance Epsilon a => Epsilon (V1 a) where-  nearZero (unlift -> V1 x) = nearZero x+  nearZero (V1_ x) = nearZero x  instance A.Functor V1 where-  fmap f (unlift -> V1 x) = lift (V1 (f x))-  x <$ _                  = lift (V1 x)+  fmap f (V1_ x) = V1_ (f x)+  x <$ _         = V1_ x 

@@ -2,19 +2,19 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# 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..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -23,18 +23,18 @@  module Data.Array.Accelerate.Linear.V2 ( -  V2(..), R1(..), R2(..),+  V2(..), pattern V2_,+  R1(..),+  R2(..),   _yx,   ex, ey,   perp, angle,  ) where -import Data.Array.Accelerate                    as A+import Data.Array.Accelerate                    as A hiding ( pattern V2 ) import Data.Array.Accelerate.Data.Functor       as A import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Array.Sugar  import Data.Array.Accelerate.Linear.Epsilon import Data.Array.Accelerate.Linear.Lift@@ -59,7 +59,7 @@  -- | the counter-clockwise perpendicular vector ----- >>> test $ perp $ lift (V2 10 20 :: V2 Int)+-- >>> test $ perp $ (V2_ 10 20 :: Exp (V2 Int)) -- V2 (-20) 10 -- perp :: forall a. A.Num a => Exp (V2 a) -> Exp (V2 a)@@ -77,10 +77,10 @@ -- class (L.R2 t, R1 t) => R2 t where   -- |-  -- >>> test $ lift (V2 1 2 :: V2 Int) ^._y+  -- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) ^. _y   -- 2   ---  -- >>> test $ lift (V2 1 2 :: V2 Int) & _y .~ 3+  -- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) & _y .~ 3   -- V2 1 3   --   _y :: (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)@@ -91,7 +91,7 @@   -- |--- >>> test $ lift (V2 1 2 :: V2 Int) ^. _yx+-- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) ^. _yx -- V2 2 1 -- _yx :: forall t a. (R2 t, Elt a, Box t a) => Lens' (Exp (t a)) (Exp (V2 a))@@ -105,33 +105,22 @@ -- Instances -- --------- +pattern V2_ :: Elt a => Exp a -> Exp a -> Exp (V2 a)+pattern V2_ x y = Pattern (x,y)+{-# COMPLETE V2_ #-}+ 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 Elt a => Elt (V2 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+  lift (V2 x y) = V2_ (lift x) (lift y)  instance Elt a => Unlift Exp (V2 (Exp a)) where-  unlift t = V2 (Exp $ SuccTupIdx ZeroTupIdx `Prj` t)-                (Exp $ ZeroTupIdx `Prj` t)+  unlift (V2_ x y) = V2 x y  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))@@ -148,15 +137,15 @@   min  = v2 $$ on A.min t2   max  = v2 $$ on A.max t2 -t2 :: Elt a => Exp (V2 a) -> Exp (a,a)-t2 (unlift -> V2 x y) = tup2 (x,y)+t2 :: Exp (V2 a) -> Exp (a, a)+t2 (Exp e) = Exp e -v2 :: Elt a => Exp (a,a) -> Exp (V2 a)-v2 (untup2 -> (x,y)) = lift (V2 x y)+v2 :: Exp (a, a) -> Exp (V2 a)+v2 (Exp e) = Exp e  instance A.Bounded a => P.Bounded (Exp (V2 a)) where-  minBound = lift (V2 (minBound :: Exp a) (minBound :: Exp a))-  maxBound = lift (V2 (maxBound :: Exp a) (maxBound :: Exp a))+  minBound = V2_ minBound minBound+  maxBound = V2_ maxBound maxBound  instance A.Num a => P.Num (Exp (V2 a)) where   (+)             = lift2 ((+) :: V2 (Exp a) -> V2 (Exp a) -> V2 (Exp a))@@ -193,6 +182,6 @@   nearZero = nearZero . quadrance  instance A.Functor V2 where-  fmap f (unlift -> V2 x y) = lift (V2 (f x) (f y))-  x <$ _                    = lift (V2 x x)+  fmap f (V2_ x y) = V2_ (f x) (f y)+  x <$ _           = V2_ x x 

@@ -2,19 +2,19 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# 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..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -23,7 +23,8 @@  module Data.Array.Accelerate.Linear.V3 ( -  V3(..), cross, triple,+  V3(..), pattern V3_,+  cross, triple,   R1(..),   R2(..),   _yx,@@ -34,11 +35,9 @@  ) where -import Data.Array.Accelerate                    as A+import Data.Array.Accelerate                    as A hiding ( pattern V2, pattern V3 ) import Data.Array.Accelerate.Data.Functor       as A import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Array.Sugar  import Data.Array.Accelerate.Linear.Epsilon import Data.Array.Accelerate.Linear.Lift@@ -78,10 +77,10 @@ -- class (L.R3 t, R2 t) => R3 t where   -- |-  -- >>> test $ lift (V3 1 2 3 :: V3 Int) ^. _z+  -- >>> test $ (V3_ 1 2 3 :: Exp (V3 Int)) ^. _z   -- 3   ---  -- >>> test $ lift (V3 1 2 3 :: V3 Int) & _z .~ 42+  -- >>> test $ (V3_ 1 2 3 :: Exp (V3 Int)) & _z .~ 42   -- V3 1 2 42   --   _z :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)@@ -112,35 +111,23 @@ -- Instances -- --------- +pattern V3_ :: Elt a => Exp a -> Exp a -> Exp a -> Exp (V3 a)+pattern V3_ x y z = Pattern (x,y,z)+{-# COMPLETE V3_ #-}+ 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 Elt a => Elt (V3 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+  lift (V3 x y z) = V3_ (lift x) (lift y) (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)+  unlift (V3_ x y z) = V3 x y z  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))@@ -157,15 +144,15 @@   min  = v3 $$ on A.min t3   max  = v3 $$ on A.max t3 -t3 :: Elt a => Exp (V3 a) -> Exp (a,a,a)-t3 (unlift -> V3 x y z) = tup3 (x,y,z)+t3 :: Exp (V3 a) -> Exp (a, a, a)+t3 (Exp e) = Exp e -v3 :: Elt a => Exp (a,a,a) -> Exp (V3 a)-v3 (untup3 -> (x,y,z)) = lift (V3 x y z)+v3 :: Exp (a, a, a) -> Exp (V3 a)+v3 (Exp e) = Exp e  instance A.Bounded a => P.Bounded (Exp (V3 a)) where-  minBound = lift (V3 (minBound :: Exp a) (minBound :: Exp a) (minBound :: Exp a))-  maxBound = lift (V3 (maxBound :: Exp a) (maxBound :: Exp a) (maxBound :: Exp a))+  minBound = V3_ minBound minBound minBound+  maxBound = V3_ maxBound maxBound maxBound  instance A.Num a => P.Num (Exp (V3 a)) where   (+)             = lift2 ((+) :: V3 (Exp a) -> V3 (Exp a) -> V3 (Exp a))@@ -202,8 +189,8 @@   nearZero = nearZero . quadrance  instance A.Functor V3 where-  fmap f (unlift -> V3 x y z) = lift (V3 (f x) (f y) (f z))-  x <$ _                      = lift (V3 x x x)+  fmap f (V3_ x y z) = V3_ (f x) (f y) (f z)+  x <$ _             = V3_ x x x  -- $liftAcc --

@@ -2,19 +2,19 @@ {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PatternSynonyms       #-} {-# 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..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -23,7 +23,8 @@  module Data.Array.Accelerate.Linear.V4 ( -  V4(..), vector, point, normalizePoint,+  V4(..), pattern V4_,+  vector, point, normalizePoint,   R1(..),   R2(..),   _yx,@@ -41,11 +42,9 @@  ) where -import Data.Array.Accelerate                    as A+import Data.Array.Accelerate                    as A hiding ( pattern V2, pattern V3, pattern V4 ) import Data.Array.Accelerate.Data.Functor       as A import Data.Array.Accelerate.Smart-import Data.Array.Accelerate.Product-import Data.Array.Accelerate.Array.Sugar  import Data.Array.Accelerate.Linear.Epsilon import Data.Array.Accelerate.Linear.Lift@@ -95,10 +94,10 @@ -- class (L.R4 t, R3 t) => R4 t where   -- |-  -- >>> test $ lift (V4 1 2 3 4 :: V4 Int) ^._w+  -- >>> test $ (V4_ 1 2 3 4 :: Exp (V4 Int)) ^. _w   -- 4   ---  -- >>> test $ lift (V4 1 2 3 4 :: V4 Int) & _w .~ 42+  -- >>> test $ (V4_ 1 2 3 4 :: Exp (V4 Int)) & _w .~ 42   -- V4 1 2 3 42   --   _w :: forall a. (Elt a, Box t a) => Lens' (Exp (t a)) (Exp a)@@ -176,41 +175,24 @@ -- Instances -- --------- +pattern V4_ :: Elt a => Exp a -> Exp a -> Exp a -> Exp a -> Exp (V4 a)+pattern V4_ x y z w = Pattern (x,y,z,w)+{-# COMPLETE V4_ #-}+ 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 Elt a => Elt (V4 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+  lift (V4 x y z w) = V4_ (lift x) (lift y) (lift z) (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)+  unlift (V4_ x y z w) = V4 x y z w  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))@@ -227,15 +209,15 @@   min  = v4 $$ on A.min t4   max  = v4 $$ on A.max t4 -t4 :: Elt a => Exp (V4 a) -> Exp (a,a,a,a)-t4 (unlift -> V4 x y z w) = tup4 (x,y,z,w)+t4 :: Exp (V4 a) -> Exp (a, a, a, a)+t4 (Exp e) = Exp e -v4 :: Elt a => Exp (a,a,a,a) -> Exp (V4 a)-v4 (untup4 -> (x,y,z,w)) = lift (V4 x y z w)+v4 :: Exp (a, a, a, a) -> Exp (V4 a)+v4 (Exp e) = Exp e  instance A.Bounded a => P.Bounded (Exp (V4 a)) where-  minBound = lift (V4 (minBound :: Exp a) (minBound :: Exp a) (minBound :: Exp a) (minBound :: Exp a))-  maxBound = lift (V4 (maxBound :: Exp a) (maxBound :: Exp a) (maxBound :: Exp a) (maxBound :: Exp a))+  minBound = V4_ minBound minBound minBound minBound+  maxBound = V4_ maxBound maxBound maxBound maxBound  instance A.Num a => P.Num (Exp (V4 a)) where   (+)             = lift2 ((+) :: V4 (Exp a) -> V4 (Exp a) -> V4 (Exp a))@@ -272,6 +254,5 @@   nearZero = nearZero . quadrance  instance A.Functor V4 where-  fmap f (unlift -> V4 x y z w) = lift (V4 (f x) (f y) (f z) (f w))-  x <$ _                        = lift (V4 x x x x)-+  fmap f (V4_ x y z w) = V4_ (f x) (f y) (f z) (f w)+  x <$ _               = V4_ x x x x

@@ -1,17 +1,17 @@ {-# LANGUAGE ConstraintKinds     #-} {-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE PatternSynonyms     #-} {-# LANGUAGE RankNTypes          #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies        #-}-{-# LANGUAGE ViewPatterns        #-} ----------------------------------------------------------------------------- -- | -- Module      : Data.Array.Accelerate.Linear.Vector -- Copyright   : 2014 Edward Kmett, Charles Durham,---               [2015..2018] Trevor L. McDonell+--               [2015..2020] Trevor L. McDonell -- License     : BSD-style (see the file LICENSE) ----- Maintainer  : Edward Kmett <ekmett@gmail.com>+-- Maintainer  : Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   : experimental -- Portability : non-portable --@@ -21,7 +21,7 @@ module Data.Array.Accelerate.Linear.Vector   where -import Data.Array.Accelerate                    as A+import Data.Array.Accelerate                    as A hiding ( pattern V2 ) import Data.Array.Accelerate.Linear.Type  import Control.Lens@@ -32,8 +32,9 @@ infixl 7 ^*, *^, ^/, /^  -- $setup+-- >>> :set -XPatternSynonyms -- >>> import Linear.V2--- >>> import Data.Array.Accelerate.Linear.V2 ()+-- >>> import Data.Array.Accelerate.Linear.V2 ( pattern V2_ ) -- >>> import Data.Array.Accelerate.Interpreter -- >>> :{ --   let test :: Elt e => Exp e -> e@@ -53,7 +54,7 @@    -- | Compute the sum of two vectors   ---  -- >>> test $ lift (V2 1 2 :: V2 Int) ^+^ lift (V2 3 4 :: V2 Int)+  -- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) ^+^ (V2_ 3 4 :: Exp (V2 Int))   -- V2 4 6   --   (^+^) :: forall a. (A.Num a, Box f a)@@ -64,7 +65,7 @@    -- | Compute the difference between two vectors   ---  -- >>> test $ lift (V2 4 5 :: V2 Int) ^-^ lift (V2 3 1 :: V2 Int)+  -- >>> test $ (V2_ 4 5 :: Exp (V2 Int)) ^-^ (V2_ 3 1 :: Exp (V2 Int))   -- V2 1 4   --   (^-^) :: forall a. (A.Num a, Box f a)@@ -95,7 +96,7 @@  -- | Compute the negation of a vector ----- >>> test $ negated (lift (V2 2 4 :: V2 Int))+-- >>> test $ negated (V2_ 2 4 :: Exp (V2 Int)) -- V2 (-2) (-4) -- negated@@ -106,7 +107,7 @@  -- | Compute the left scalar product ----- >>> test $ 2 *^ lift (V2 3 4 :: V2 Int)+-- >>> test $ 2 *^ (V2_ 3 4 :: Exp (V2 Int)) -- V2 6 8 -- (*^) :: forall f a. (Functor f, A.Num a, Box f a)@@ -117,7 +118,7 @@  -- | Compute the right scalar product ----- >>> test $ lift (V2 3 4 :: V2 Int) ^* 2+-- >>> test $ (V2_ 3 4 :: Exp (V2 Int)) ^* 2 -- V2 6 8 -- (^*) :: forall f a. (Functor f, A.Num a, Box f a)@@ -128,7 +129,7 @@  -- | Compute division by a scalar on the right ----- >>> test $ lift (V2 4 6 :: V2 Double) ^/ 2+-- >>> test $ (V2_ 4 6 :: Exp (V2 Double)) ^/ 2 -- V2 2.0 3.0 -- (^/) :: forall f a. (Functor f, A.Fractional a, Box f a)@@ -139,7 +140,7 @@  -- | Compute division of a scalar on the left ----- >>> test $ 4 /^ lift (V2 2 4 :: V2 Double)+-- >>> test $ 4 /^ (V2_ 2 4 :: Exp (V2 Double)) -- V2 2.0 1.0 -- (/^) :: forall f a. (Functor f, A.Fractional a, Box f a)@@ -150,7 +151,7 @@  -- | Addition with a scalar on the left ----- >>> test $ 2 +^ lift (V2 3 4 :: V2 Int)+-- >>> test $ 2 +^ (V2_ 3 4 :: Exp (V2 Int)) -- V2 5 6 -- (+^) :: forall f a. (Functor f, A.Num a, Box f a)@@ -161,7 +162,7 @@  -- | Addition with a scalar on the right ----- >>> test $ lift (V2 1 2 :: V2 Int) ^+ 3+-- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) ^+ 3 -- V2 4 5 -- (^+) :: forall f a. (Functor f, A.Num a, Box f a)@@ -172,7 +173,7 @@  -- | Subtraction with a scalar on the left ----- >>> test $ 2 -^ lift (V2 3 4 :: V2 Int)+-- >>> test $ 2 -^ (V2_ 3 4 :: Exp (V2 Int)) -- V2 (-1) (-2) -- (-^) :: forall f a. (Functor f, A.Num a, Box f a)@@ -183,7 +184,7 @@  -- | Subtraction with a scalar on the right ----- >>> test $ lift (V2 1 2 :: V2 Int) ^- 3+-- >>> test $ (V2_ 1 2 :: Exp (V2 Int)) ^- 3 -- V2 (-2) (-1) -- (^-) :: forall f a. (Functor f, A.Num a, Box f a)

@@ -3,7 +3,7 @@ -- Module      :  Main (doctests) -- Copyright   :  (C) 2012-14 Edward Kmett -- License     :  BSD-style (see the file LICENSE)--- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Maintainer  :  Trevor L. McDonell <trevor.mcdonell@gmail.com> -- Stability   :  provisional -- Portability :  portable --