Tensor (empty) → 1.0.0.0

raw patch · 4 files changed

+393/−0 lines, 4 filesdep +basesetup-changed

Dependencies added: base

Files

• LICENSE +28/−0
• Setup.hs +2/−0
• Tensor.cabal +17/−0
• src/Data/Tensor.hs +346/−0

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

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,17 @@+name: Tensor+version: 1.0.0.0+license: BSD3+license-file: LICENSE+maintainer: Sven Panne <sven.panne@aedion.de>+bug-reports: mailto:hopengl@haskell.org+homepage: http://www.haskell.org/HOpenGL/+category: Data+synopsis: State variables+description:+   This package contains tensor data types and their instances for some basic+   type classes.+build-type: Simple+exposed-modules: Data.Tensor+hs-Source-Dirs: src+ghc-options: -Wall+build-depends: base >= 3 && < 5

@@ -0,0 +1,346 @@+--------------------------------------------------------------------------------+-- |+-- Module      :  Data.Tensor+-- Copyright   :  (c) Sven Panne 2009+-- License     :  BSD-style (see the file LICENSE)+-- +-- Maintainer  :  sven.panne@aedion.de+-- Stability   :  stable+-- Portability :  portable+--+-- This package contains tensor data types and their instances for some basic+-- type classes.+--+--------------------------------------------------------------------------------++module Data.Tensor (+   Vertex1(..), Vertex2(..), Vertex3(..), Vertex4(..),+   Vector1(..), Vector2(..), Vector3(..), Vector4(..)+) where++import Control.Applicative+import Control.Monad+import Data.Foldable+import Data.Ix+import Data.Traversable+import Data.Typeable+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.Storable++--------------------------------------------------------------------------------++-- | A vertex with /y/=0, /z/=0 and /w/=1.+newtype Vertex1 a = Vertex1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vertex1 where+   fmap f (Vertex1 x) = Vertex1 (f x)++instance Applicative Vertex1 where+   pure a = Vertex1 a+   Vertex1 f <*> Vertex1 x = Vertex1 (f x)++instance Foldable Vertex1 where+   foldr f a (Vertex1 x) = x `f ` a+   foldl f a (Vertex1 x) = a `f` x+   foldr1 _ (Vertex1 x) = x+   foldl1 _ (Vertex1 x) = x++instance Traversable Vertex1 where+   traverse f (Vertex1 x) = pure Vertex1 <*> f x+   sequenceA (Vertex1 x) =  pure Vertex1 <*> x+   mapM f (Vertex1 x) = return Vertex1 `ap` f x+   sequence (Vertex1 x) = return Vertex1 `ap` x++instance Typeable1 Vertex1 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vertex1") []++instance Typeable a => Typeable (Vertex1 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vertex1 a) where+   sizeOf    ~(Vertex1 s) = sizeOf s+   alignment ~(Vertex1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A vertex with /z/=0 and /w/=1.+data Vertex2 a = Vertex2 !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vertex2 where+   fmap f (Vertex2 x y) = Vertex2 (f x) (f y)++instance Applicative Vertex2 where+   pure a = Vertex2 a a+   Vertex2 f g <*> Vertex2 x y = Vertex2 (f x) (g y)++instance Foldable Vertex2 where+   foldr f a (Vertex2 x y) = x `f ` (y `f` a)+   foldl f a (Vertex2 x y) = (a `f` x) `f` y+   foldr1 f (Vertex2 x y) = x `f` y+   foldl1 f (Vertex2 x y) = x `f` y++instance Traversable Vertex2 where+   traverse f (Vertex2 x y) = pure Vertex2 <*> f x <*> f y+   sequenceA (Vertex2 x y) =  pure Vertex2 <*> x <*> y+   mapM f (Vertex2 x y) = return Vertex2 `ap` f x `ap` f y+   sequence (Vertex2 x y) = return Vertex2 `ap` x `ap` y++instance Typeable1 Vertex2 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vertex2") []++instance Typeable a => Typeable (Vertex2 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vertex2 a) where+   sizeOf ~(Vertex2 x _) = 2 * sizeOf x+   alignment ~(Vertex2 x _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A vertex with /w/=1.+data Vertex3 a = Vertex3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vertex3 where+   fmap f (Vertex3 x y z) = Vertex3 (f x) (f y) (f z)++instance Applicative Vertex3 where+   pure a = Vertex3 a a a+   Vertex3 f g h <*> Vertex3 x y z = Vertex3 (f x) (g y) (h z)++instance Foldable Vertex3 where+   foldr f a (Vertex3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Vertex3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Vertex3 x y z) = x `f` (y `f` z)+   foldl1 f (Vertex3 x y z) = (x `f` y) `f` z++instance Traversable Vertex3 where+   traverse f (Vertex3 x y z) = pure Vertex3 <*> f x <*> f y <*> f z+   sequenceA (Vertex3 x y z) =  pure Vertex3 <*> x <*> y <*> z+   mapM f (Vertex3 x y z) = return Vertex3 `ap` f x `ap` f y `ap` f z+   sequence (Vertex3 x y z) = return Vertex3 `ap` x `ap` y `ap` z++instance Typeable1 Vertex3 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vertex3") []++instance Typeable a => Typeable (Vertex3 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vertex3 a) where+   sizeOf ~(Vertex3 x _ _) = 3 * sizeOf x+   alignment ~(Vertex3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A fully-fledged four-dimensional vertex.+data Vertex4 a = Vertex4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vertex4 where+   fmap f (Vertex4 x y z w) = Vertex4 (f x) (f y) (f z) (f w)++instance Applicative Vertex4 where+   pure a = Vertex4 a a a a+   Vertex4 f g h i <*> Vertex4 x y z w = Vertex4 (f x) (g y) (h z) (i w)++instance Foldable Vertex4 where+   foldr f a (Vertex4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (Vertex4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (Vertex4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (Vertex4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable Vertex4 where+   traverse f (Vertex4 x y z w) = pure Vertex4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (Vertex4 x y z w) =  pure Vertex4 <*> x <*> y <*> z <*> w+   mapM f (Vertex4 x y z w) = return Vertex4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (Vertex4 x y z w) = return Vertex4 `ap` x `ap` y `ap` z `ap` w++instance Typeable1 Vertex4 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vertex4") []++instance Typeable a => Typeable (Vertex4 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vertex4 a) where+   sizeOf ~(Vertex4 x _ _ _) = 4 * sizeOf x+   alignment ~(Vertex4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A one-dimensional vector.+newtype Vector1 a = Vector1 a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vector1 where+   fmap f (Vector1 x) = Vector1 (f x)++instance Applicative Vector1 where+   pure a = Vector1 a+   Vector1 f <*> Vector1 x = Vector1 (f x)++instance Foldable Vector1 where+   foldr f a (Vector1 x) = x `f ` a+   foldl f a (Vector1 x) = a `f` x+   foldr1 _ (Vector1 x) = x+   foldl1 _ (Vector1 x) = x++instance Traversable Vector1 where+   traverse f (Vector1 x) = pure Vector1 <*> f x+   sequenceA (Vector1 x) =  pure Vector1 <*> x+   mapM f (Vector1 x) = return Vector1 `ap` f x+   sequence (Vector1 x) = return Vector1 `ap` x++instance Typeable1 Vector1 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vector1") []++instance Typeable a => Typeable (Vector1 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vector1 a) where+   sizeOf    ~(Vector1 s) = sizeOf s+   alignment ~(Vector1 s) = alignment s+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A two-dimensional vector.+data Vector2 a = Vector2 !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vector2 where+   fmap f (Vector2 x y) = Vector2 (f x) (f y)++instance Applicative Vector2 where+   pure a = Vector2 a a+   Vector2 f g <*> Vector2 x y = Vector2 (f x) (g y)++instance Foldable Vector2 where+   foldr f a (Vector2 x y) = x `f ` (y `f` a)+   foldl f a (Vector2 x y) = (a `f` x) `f` y+   foldr1 f (Vector2 x y) = x `f` y+   foldl1 f (Vector2 x y) = x `f` y++instance Traversable Vector2 where+   traverse f (Vector2 x y) = pure Vector2 <*> f x <*> f y+   sequenceA (Vector2 x y) =  pure Vector2 <*> x <*> y+   mapM f (Vector2 x y) = return Vector2 `ap` f x `ap` f y+   sequence (Vector2 x y) = return Vector2 `ap` x `ap` y++instance Typeable1 Vector2 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vector2") []++instance Typeable a => Typeable (Vector2 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vector2 a) where+   sizeOf ~(Vector2 x _) = 2 * sizeOf x+   alignment ~(Vector2 x _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A three-dimensional vector.+data Vector3 a = Vector3 !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vector3 where+   fmap f (Vector3 x y z) = Vector3 (f x) (f y) (f z)++instance Applicative Vector3 where+   pure a = Vector3 a a a+   Vector3 f g h <*> Vector3 x y z = Vector3 (f x) (g y) (h z)++instance Foldable Vector3 where+   foldr f a (Vector3 x y z) = x `f ` (y `f` (z `f` a))+   foldl f a (Vector3 x y z) = ((a `f` x) `f` y) `f` z+   foldr1 f (Vector3 x y z) = x `f` (y `f` z)+   foldl1 f (Vector3 x y z) = (x `f` y) `f` z++instance Traversable Vector3 where+   traverse f (Vector3 x y z) = pure Vector3 <*> f x <*> f y <*> f z+   sequenceA (Vector3 x y z) =  pure Vector3 <*> x <*> y <*> z+   mapM f (Vector3 x y z) = return Vector3 `ap` f x `ap` f y `ap` f z+   sequence (Vector3 x y z) = return Vector3 `ap` x `ap` y `ap` z++instance Typeable1 Vector3 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vector3") []++instance Typeable a => Typeable (Vector3 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vector3 a) where+   sizeOf ~(Vector3 x _ _) = 3 * sizeOf x+   alignment ~(Vector3 x _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++-- | A four-dimensional vector.+data Vector4 a = Vector4 !a !a !a !a+   deriving (Eq, Ord, Ix, Bounded, Show, Read)++instance Functor Vector4 where+   fmap f (Vector4 x y z w) = Vector4 (f x) (f y) (f z) (f w)++instance Applicative Vector4 where+   pure a = Vector4 a a a a+   Vector4 f g h i <*> Vector4 x y z w = Vector4 (f x) (g y) (h z) (i w)++instance Foldable Vector4 where+   foldr f a (Vector4 x y z w) = x `f ` (y `f` (z `f` (w `f` a)))+   foldl f a (Vector4 x y z w) = (((a `f` x) `f` y) `f` z) `f` w+   foldr1 f (Vector4 x y z w) = x `f` (y `f` (z `f` w))+   foldl1 f (Vector4 x y z w) = ((x `f` y) `f` z) `f` w++instance Traversable Vector4 where+   traverse f (Vector4 x y z w) = pure Vector4 <*> f x <*> f y <*> f z <*> f w+   sequenceA (Vector4 x y z w) =  pure Vector4 <*> x <*> y <*> z <*> w+   mapM f (Vector4 x y z w) = return Vector4 `ap` f x `ap` f y `ap` f z `ap` f w+   sequence (Vector4 x y z w) = return Vector4 `ap` x `ap` y `ap` z `ap` w++instance Typeable1 Vector4 where+   typeOf1 _ = mkTyConApp (mkTyCon "Vector4") []++instance Typeable a => Typeable (Vector4 a) where+   typeOf = typeOfDefault++instance Storable a => Storable (Vector4 a) where+   sizeOf ~(Vector4 x _ _ _) = 4 * sizeOf x+   alignment ~(Vector4 x _ _ _) = alignment x+   peek = peekApplicativeTraversable+   poke = pokeFoldable++--------------------------------------------------------------------------------++peekApplicativeTraversable :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> IO (t a)+peekApplicativeTraversable = Data.Traversable.mapM peek . addresses++addresses :: (Applicative t, Traversable t, Storable a) => Ptr (t a) -> t (Ptr a)+addresses = snd . mapAccumL nextPtr 0 . pure . castPtr++nextPtr :: Storable a => Int -> Ptr a -> (Int, Ptr a)+nextPtr offset ptr = (offset + 1, advancePtr ptr offset)++--------------------------------------------------------------------------------++pokeFoldable :: (Foldable t, Storable a) => Ptr (t a) -> t a -> IO ()+pokeFoldable ptr xs = foldlM pokeAndAdvance (castPtr ptr) xs >> return ()++pokeAndAdvance :: Storable a => Ptr a -> a -> IO (Ptr a)+pokeAndAdvance ptr value = do+   poke ptr value+   return $ ptr `plusPtr` sizeOf value