Vec 0.9.1 → 0.9.2
raw patch · 4 files changed
+299/−251 lines, 4 filesdep +QuickCheck
Dependencies added: QuickCheck
Files
- Data/Vec/Base.hs +27/−11
- Data/Vec/Instances.hs +28/−16
- Data/Vec/Packed.hs +241/−222
- Vec.cabal +3/−2
Data/Vec/Base.hs view
@@ -21,7 +21,7 @@ import Prelude hiding (map,zipWith,foldl,foldr,reverse, take,drop,head,tail,sum,last,product,- minimum,maximum)+ minimum,maximum,length) import qualified Prelude as P @@ -37,7 +37,7 @@ --derived show outputs in prefix notation instance (Show a, ShowVec v) => Show (a:.v) where- show (a:.v) = "(" ++ show a ++ ":." ++ showVec v ++ ")"+ show (a:.v) = "(" ++ show a ++ "):." ++ showVec v -- | Helper to keep parentheses at bay. Just use @show@ as usual.@@ -49,7 +49,7 @@ {-# INLINE showVec #-} instance (Show a, ShowVec v) => ShowVec (a:.v) where- showVec (a:.v) = show a ++ ":." ++ showVec v+ showVec (a:.v) = "(" ++ show a ++ "):." ++ showVec v {-# INLINE showVec #-} @@ -247,10 +247,14 @@ {-# INLINE foldr #-} -- | Reverse a vector +reverse :: (Reverse' () v v') => v -> v' reverse v = reverse' () v {-# INLINE reverse #-} --- Reverse helper function : builds the reversed list as its first argument+-- really the type of reverse should b v->v but somehow this makes inference easier+++-- | Reverse helper function : accumulates the reversed list in its first argument class Reverse' p v v' | p v -> v' where reverse' :: p -> v -> v' @@ -286,14 +290,15 @@ -- type-level natural. For example @take n3 v@ makes a 3-vector of the first -- three elements of @v@. -class Take n v v' | n v -> v', n v' -> v where+class Take n v v' | n v -> v' where take :: n -> v -> v' instance Take N0 v () where take _ _ = () {-# INLINE take #-} -instance Take n v v' => Take (Succ n) (a:.v) (a:.v') where+instance Take n v v' + => Take (Succ n) (a:.v) (a:.v') where take _ (a:.v) = a:.(take (undefined::n) v) {-# INLINE take #-} @@ -301,15 +306,16 @@ -- | @drop n v@ strips the first @n@ elements from @v@. @n@ is a type-level -- natural. For example @drop n2 v@ drops the first two elements. -class Drop n v v' | n v -> v', n v' -> v where+class Drop n v v' | n v -> v' where drop :: n -> v -> v' instance Drop N0 v v where drop _ = id {-# INLINE drop #-} -instance (Tail v' v'', Drop n v v') => Drop (Succ n) v v'' where- drop _ = tail . drop (undefined::n)+instance (Drop n (a:.v) v') + => Drop (Succ n) (a:.a:.v) v' where+ drop _ (a:.v) = drop (undefined::n) v {-# INLINE drop #-} @@ -326,9 +332,9 @@ last (a:.v) = last v {-# INLINE last #-} --- | @snoc v a@ appends the element a to the end of v. -class Snoc v a v' | v a -> v', v' -> v a where +-- | @snoc v a@ appends the element a to the end of v. +class Snoc v a v' | v a -> v', v' -> v a, v -> a where snoc :: v -> a -> v' instance Snoc () a (a:.()) where@@ -339,6 +345,16 @@ snoc (b:.v) a = b:.(snoc v a) {-# INLINE snoc #-} ++-- | The length of a vector+class Length v n | v -> n where+ length :: v -> Int++instance Length () N0 where+ length _ = 0++instance (Length v n) => Length (a:.v) (Succ n) where+ length (_:.v) = 1+length v -- | sum of vector elements
Data/Vec/Instances.hs view
@@ -1,7 +1,6 @@ {- Copyright (c) 2008, Scott E. Dillard. All rights reserved. -} {-# OPTIONS -cpp #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-}@@ -21,18 +20,19 @@ import Data.Vec.Nat import Foreign.Storable import Foreign.Ptr+import Test.QuickCheck -- Storable instances. instance Storable a => Storable (a:.()) where sizeOf _ = sizeOf (undefined::a) alignment _ = alignment (undefined::a)- peek !p = peek (castPtr p) >>= \a -> return (a:.())- peekByteOff !p !o = peek (p`plusPtr`o)- peekElemOff !p !i = peek (p`plusPtr`(i*sizeOf(undefined::a)))- poke !p (a:._) = poke (castPtr p) a- pokeByteOff !p !o !x = poke (p`plusPtr`o) x- pokeElemOff !p !i !x = poke (p`plusPtr`(i*sizeOf(undefined::a))) x+ peek p = peek (castPtr p) >>= \a -> return (a:.())+ peekByteOff p o = peek (p`plusPtr`o)+ peekElemOff p i = peek (p`plusPtr`(i*sizeOf(undefined::a)))+ poke p (a:._) = poke (castPtr p) a+ pokeByteOff p o x = poke (p`plusPtr`o) x+ pokeElemOff p i x = poke (p`plusPtr`(i*sizeOf(undefined::a))) x {-# INLINE sizeOf #-} {-# INLINE alignment #-} {-# INLINE peek #-}@@ -47,17 +47,17 @@ where sizeOf _ = sizeOf (undefined::a) + sizeOf (undefined::(a:.v)) alignment _ = alignment (undefined::a)- peek !p = + peek p = peek (castPtr p) >>= \a -> peek (castPtr (p`plusPtr`sizeOf(undefined::a))) >>= \v -> return (a:.v)- peekByteOff !p !o = peek (p`plusPtr`o)- peekElemOff !p !i = peek (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v))))- poke !p (a:.v) = + peekByteOff p o = peek (p`plusPtr`o)+ peekElemOff p i = peek (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v))))+ poke p (a:.v) = poke (castPtr p) a >> poke (castPtr (p`plusPtr`sizeOf(undefined::a))) v- pokeByteOff !p !o !x = poke (p`plusPtr`o) x- pokeElemOff !p !i !x = poke (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v)))) x+ pokeByteOff p o x = poke (p`plusPtr`o) x+ pokeElemOff p i x = poke (p`plusPtr`(i*sizeOf(undefined::(a:.a:.v)))) x {-# INLINE sizeOf #-} {-# INLINE alignment #-} {-# INLINE peek #-}@@ -71,11 +71,9 @@ -- Num and Fractional instances : All arithmetic is done component-wise and -- literals construct uniform vectors and matrices. ----- The rule is simple : +-- The rule is : -- If the method is unary, it's a map. -- If it's binary, it's a zipWith.------ You are free to ignore these instances if the definition of (*) offends you. instance (Eq (a:.u)@@ -118,3 +116,17 @@ {-# INLINE recip #-} {-# INLINE fromRational #-} +++-- Arbitrary instances++instance Arbitrary a => Arbitrary (a:.()) where+ arbitrary = arbitrary >>= return . (:.())+ coarbitrary (a:._) = variant 0 . coarbitrary a++instance (Length (a:.v) (Succ n), Arbitrary a', Arbitrary (a:.v)) => Arbitrary (a':.a:.v) where+ arbitrary = arbitrary >>= \a -> + arbitrary >>= \v -> return (a:.v);+ coarbitrary (a:.v) = variant (V.length v) . coarbitrary a . coarbitrary v++
Data/Vec/Packed.hs view
@@ -1,284 +1,303 @@ {- Copyright (c) 2008, Scott E. Dillard. All rights reserved. -}-{-# OPTIONS -cpp #-} --{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} --- | Packed vectors : use these whenever possible. The regular vector type is--- just a gussied up linked list, but when vector functions are applied to--- these types, bracketed by @'pack'@ and @'unpack'@, then things unfold into--- neatly optimized code. +-- | Packed vectors : use these whenever possible. The generic vector type is+-- is represented at run-time by a linked list of boxed values. Packed types,+-- however, store the vector components sequentially in memory. Vector+-- operations can be defined using the generic types, and the compiler will+-- inline and specialize these definitions for the packed types, avoiding any+-- list cells or unnecessary heap allocations.+--+-- Packed vectors are related to their unpacked representations by way of an+-- associated type. An instance of class @'PackedVec' v@ declares that @v@ has+-- a packed representation, and the type of that is @'Packed' v@. The packed+-- constructors are named @Vec@/NT/ where /N/ is 2, 3 or 4 and /T/ is @I@, @F@+-- or @D@ for @Int@, @Float@ or @Double@. So the expression @Vec3D x y z@+-- constructs a packed 3-vector of Doubles, the type of which is @Packed (Vec3+-- Double)@. The constructor name is also a synonym for the packed type name,+-- i.e., @type Vec3D = Packed (Vec3 Double)@, so the packed type acts as if it+-- had been declared @data Vec3D = Vec3D x y z@. -- --- Storable, Num, Fractional, Fold, Map, and ZipWith instances are provided for--- packed vectors, so some operations do not require pack/unpack. For example,--- @'dot'@ does not require pack/unpack because it is defined in terms of--- @'zipWith'@ and @'fold'@. However @'transpose'@, @'det'@, @'gaussElim'@ and--- most others are recursive, and so you'll still need to use pack/unpack with--- these. This goes for @'multmm'@ as well because it uses @'transpose'@, and--- @'multmv'@ does not need its arguments to be unpacked, but the result will--- be a polymorphic vector of type @(:.)@, so you will want to pack it again.--- This is all very experimental and likely to change.+-- 'Storable', 'Num', 'Fractional', 'Fold', 'Map', and 'ZipWith' instances are+-- provided for packed vectors, so some operations do not require pack/unpack.+-- For example, @'dot'@ does not require pack/unpack because it is defined in+-- terms of @'zipWith'@ and @'fold'@. However @'transpose'@, @'det'@,+-- @'gaussElim'@ and most others are recursive, and so you'll still need to+-- use pack/unpack with these. This goes for @'multmm'@ as well because it+-- uses @'transpose'@. Some functions, like @'multmv'@, do not need their+-- arguments to be unpacked, but the result is a polymorphic vector @(:.)@, so+-- you will need to pack it again. I admit that this is awkward. +--+-- There are also instances for 'Take', 'Drop', 'Last', 'Head', 'Tail' and+-- 'Snoc'. These come in handy for thinks like quaternions and homogenous+-- coordinates. module Data.Vec.Packed where -import Prelude hiding (map,foldl,foldr,zipWith)+import Prelude hiding (map,foldl,foldr,zipWith,length,head,tail,last,+ reverse,take,drop) import Data.Vec.Base as V+import Data.Vec.Nat+import Data.Vec.LinAlg --just for haddock import Data.Vec.Instances+import Data.Word+import Data.Int import Foreign+import Test.QuickCheck --- | PackedVec class : relates a packed vector type to its unpacked type For--- now, the fundep is not bijective -- It may be advantageous to have multiple--- packed representations for a canonical vector type. This may change. In the--- meantime, you may have to annotate return types.-class PackedVec pv v | pv -> v where- pack :: v -> pv- unpack :: pv -> v+-- | PackedVec class : relates a vector type to its space-optimized+-- representation. +class PackedVec v where+ -- | The packed representation of 'v'+ data Packed v + pack :: v -> Packed v+ unpack :: Packed v -> v {-# RULES "Vec pack/unpack" forall x.- pack (unpack x) = x;+ pack (unpack x) = x; "Vec unpack/pack" forall x.- unpack (pack x) = x;- "Vec pack.unpack" - pack . unpack = id;- "Vec unpack.pack"- unpack . pack = id; #-}+ unpack (pack x) = x; #-} --- * Packed Vector Types-data Vec2I = Vec2I {-#UNPACK#-} !Int - {-#UNPACK#-} !Int - deriving (Eq,Ord,Show,Read) -data Vec3I = Vec3I {-#UNPACK#-} !Int - {-#UNPACK#-} !Int - {-#UNPACK#-} !Int- deriving (Eq,Ord,Show,Read) -data Vec4I = Vec4I {-#UNPACK#-} !Int - {-#UNPACK#-} !Int - {-#UNPACK#-} !Int- {-#UNPACK#-} !Int- deriving (Eq,Ord,Show,Read) -data Vec2F = Vec2F {-#UNPACK#-} !Float - {-#UNPACK#-} !Float - deriving (Eq,Ord,Show,Read)+instance PackedVec (Vec2 Int) where + data Packed (Vec2 Int) = Vec2I {-#UNPACK#-} !Int {-#UNPACK#-} !Int+ pack (a:.b:.()) = Vec2I a b + unpack (Vec2I a b) = a:.b:.() + {-# INLINE pack #-} + {-# INLINE unpack #-} -data Vec3F = Vec3F {-#UNPACK#-} !Float - {-#UNPACK#-} !Float - {-#UNPACK#-} !Float- deriving (Eq,Ord,Show,Read)+instance PackedVec (Vec3 Int) where + data Packed (Vec3 Int) = Vec3I {-#UNPACK#-} !Int {-#UNPACK#-} !Int {-#UNPACK#-} !Int + pack (a:.b:.c:.()) = Vec3I a b c; + unpack (Vec3I a b c) = a:.b:.c:.();+ {-# INLINE pack #-} + {-# INLINE unpack #-} -data Vec4F = Vec4F {-#UNPACK#-} !Float - {-#UNPACK#-} !Float - {-#UNPACK#-} !Float- {-#UNPACK#-} !Float- deriving (Eq,Ord,Show,Read)+instance PackedVec (Vec4 Int) where + data Packed (Vec4 Int) = Vec4I {-#UNPACK#-} !Int {-#UNPACK#-} !Int {-#UNPACK#-} !Int {-#UNPACK#-} !Int+ pack (a:.b:.c:.d:.()) = Vec4I a b c d+ unpack (Vec4I a b c d) = a:.b:.c:.d:.()+ {-# INLINE pack #-}+ {-# INLINE unpack #-} -data Vec2D = Vec2D {-#UNPACK#-} !Double - {-#UNPACK#-} !Double - deriving (Eq,Ord,Show,Read) -data Vec3D = Vec3D {-#UNPACK#-} !Double - {-#UNPACK#-} !Double - {-#UNPACK#-} !Double- deriving (Eq,Ord,Show,Read)+type Vec2I = Packed (Vec2 Int)+type Vec3I = Packed (Vec3 Int)+type Vec4I = Packed (Vec4 Int) -data Vec4D = Vec4D {-#UNPACK#-} !Double - {-#UNPACK#-} !Double - {-#UNPACK#-} !Double- {-#UNPACK#-} !Double- deriving (Eq,Ord,Show,Read) --- * Packed Matrix Types-type Mat22I = Vec2 Vec2I -type Mat23I = Vec2 Vec3I -type Mat33I = Vec3 Vec3I -type Mat34I = Vec3 Vec4I -type Mat44I = Vec4 Vec3I -type Mat22F = Vec2 Vec2F -type Mat23F = Vec2 Vec3F -type Mat33F = Vec3 Vec3F -type Mat34F = Vec3 Vec4F -type Mat44F = Vec4 Vec3F -type Mat22D = Vec2 Vec2D -type Mat23D = Vec2 Vec3D -type Mat33D = Vec3 Vec3D -type Mat34D = Vec3 Vec4D -type Mat44D = Vec4 Vec4D +instance PackedVec (Vec2 Float) where + data Packed (Vec2 Float) = Vec2F {-#UNPACK#-} !Float {-#UNPACK#-} !Float+ pack (a:.b:.()) = Vec2F a b + unpack (Vec2F a b) = a:.b:.() + {-# INLINE pack #-} + {-# INLINE unpack #-} +instance PackedVec (Vec3 Float) where + data Packed (Vec3 Float) = Vec3F {-#UNPACK#-} !Float {-#UNPACK#-} !Float {-#UNPACK#-} !Float + pack (a:.b:.c:.()) = Vec3F a b c; + unpack (Vec3F a b c) = a:.b:.c:.();+ {-# INLINE pack #-} + {-# INLINE unpack #-} --- | pack a matrix-packMat :: (Map v pv m pm, PackedVec pv v) => m -> pm-packMat = V.map pack -{-# INLINE packMat #-}+instance PackedVec (Vec4 Float) where + data Packed (Vec4 Float) = Vec4F {-#UNPACK#-} !Float {-#UNPACK#-} !Float {-#UNPACK#-} !Float {-#UNPACK#-} !Float+ pack (a:.b:.c:.d:.()) = Vec4F a b c d+ unpack (Vec4F a b c d) = a:.b:.c:.d:.()+ {-# INLINE pack #-}+ {-# INLINE unpack #-} --- | unpack a matrix-unpackMat :: (Map pv v pm m, PackedVec pv v) => pm -> m-unpackMat = V.map unpack-{-# INLINE unpackMat #-}+type Vec2F = Packed (Vec2 Float)+type Vec3F = Packed (Vec3 Float)+type Vec4F = Packed (Vec4 Float) -instance PackedVec Vec2I (Vec2 Int) where- pack (x:.y:.()) = Vec2I x y - unpack (Vec2I x y) = x:.y:.()- {-# INLINE pack #-}- {-# INLINE unpack #-} -instance PackedVec Vec3I (Vec3 Int) where- pack (x:.y:.z:.()) = Vec3I x y z- unpack (Vec3I x y z) = x:.y:.z:.()- {-# INLINE pack #-}- {-# INLINE unpack #-} -instance PackedVec Vec4I (Vec4 Int) where- pack (x:.y:.z:.w:.()) = Vec4I x y z w- unpack (Vec4I x y z w) = x:.y:.z:.w:.()- {-# INLINE pack #-}- {-# INLINE unpack #-} +instance PackedVec (Vec2 Double) where + data Packed (Vec2 Double) = Vec2D {-#UNPACK#-} !Double {-#UNPACK#-} !Double+ pack (a:.b:.()) = Vec2D a b + unpack (Vec2D a b) = a:.b:.() + {-# INLINE pack #-} + {-# INLINE unpack #-} -instance PackedVec Vec2F (Vec2 Float) where- pack (x:.y:.()) = Vec2F x y - unpack (Vec2F x y) = x:.y:.()- {-# INLINE pack #-}- {-# INLINE unpack #-}+instance PackedVec (Vec3 Double) where + data Packed (Vec3 Double) = Vec3D {-#UNPACK#-} !Double {-#UNPACK#-} !Double {-#UNPACK#-} !Double + pack (a:.b:.c:.()) = Vec3D a b c; + unpack (Vec3D a b c) = a:.b:.c:.();+ {-# INLINE pack #-} + {-# INLINE unpack #-} -instance PackedVec Vec3F (Vec3 Float) where- pack (x:.y:.z:.()) = Vec3F x y z- unpack (Vec3F x y z) = x:.y:.z:.()+instance PackedVec (Vec4 Double) where + data Packed (Vec4 Double) = Vec4D {-#UNPACK#-} !Double {-#UNPACK#-} !Double {-#UNPACK#-} !Double {-#UNPACK#-} !Double+ pack (a:.b:.c:.d:.()) = Vec4D a b c d+ unpack (Vec4D a b c d) = a:.b:.c:.d:.() {-# INLINE pack #-} {-# INLINE unpack #-} -instance PackedVec Vec4F (Vec4 Float) where- pack (x:.y:.z:.w:.()) = Vec4F x y z w- unpack (Vec4F x y z w) = x:.y:.z:.w:.()- {-# INLINE pack #-}- {-# INLINE unpack #-}+type Vec2D = Packed (Vec2 Double)+type Vec3D = Packed (Vec3 Double)+type Vec4D = Packed (Vec4 Double) +type Mat22D = Vec2 (Vec2D)+type Mat23D = Vec2 (Vec3D)+type Mat24D = Vec2 (Vec4D)+type Mat33D = Vec3 (Vec3D)+type Mat34D = Vec3 (Vec4D)+type Mat44D = Vec4 (Vec4D) -instance PackedVec Vec2D (Vec2 Double) where- pack (x:.y:.()) = Vec2D x y - unpack (Vec2D x y) = x:.y:.()- {-# INLINE pack #-}- {-# INLINE unpack #-} -instance PackedVec Vec3D (Vec3 Double) where- pack (x:.y:.z:.()) = Vec3D x y z- unpack (Vec3D x y z) = x:.y:.z:.()- {-# INLINE pack #-}- {-# INLINE unpack #-}+-- | Construct a semi-packed matrix, one whose rows are packed.+packMat :: (Map row (Packed row) mat packedMat, PackedVec row) + => mat -> packedMat+packMat = map pack -instance PackedVec Vec4D (Vec4 Double) where- pack (x:.y:.z:.w:.()) = Vec4D x y z w- unpack (Vec4D x y z w) = x:.y:.z:.w:.()- {-# INLINE pack #-}- {-# INLINE unpack #-}+unpackMat :: (Map (Packed row) row packedMat mat, PackedVec row) + => packedMat -> mat+unpackMat = map unpack -#define MAP_INSTANCE(S,V) \-instance Map S S V V where map f = pack . map f . unpack+instance (Eq v, PackedVec v) => Eq (Packed v) where+ u == v = unpack u == unpack v+ u /= v = unpack u /= unpack v+ {-# INLINE (==) #-}+ {-# INLINE (/=) #-} -MAP_INSTANCE(Int,Vec2I)-MAP_INSTANCE(Int,Vec3I)-MAP_INSTANCE(Int,Vec4I)-MAP_INSTANCE(Float,Vec2F)-MAP_INSTANCE(Float,Vec3F)-MAP_INSTANCE(Float,Vec4F)-MAP_INSTANCE(Double,Vec2D)-MAP_INSTANCE(Double,Vec3D)-MAP_INSTANCE(Double,Vec4D)+instance (Ord v, PackedVec v) => Ord (Packed v) where+ compare u v = compare (unpack u) (unpack v)+ {-# INLINE compare #-} +instance (Show v, PackedVec v) => Show (Packed v) where+ show v = show (unpack v) -#define FOLD_INSTANCE(S,V) \-instance Fold S V where \- fold f = fold f . unpack; \- foldl f z = foldl f z . unpack; \- foldr f z = foldr f z . unpack;+instance (Map a b u v, PackedVec u, PackedVec v) + => Map a b (Packed u) (Packed v) + where+ map f = pack . map f . unpack+ {-# INLINE map #-} -FOLD_INSTANCE(Int,Vec2I)-FOLD_INSTANCE(Int,Vec3I)-FOLD_INSTANCE(Int,Vec4I)-FOLD_INSTANCE(Float,Vec2F)-FOLD_INSTANCE(Float,Vec3F)-FOLD_INSTANCE(Float,Vec4F)-FOLD_INSTANCE(Double,Vec2D)-FOLD_INSTANCE(Double,Vec3D)-FOLD_INSTANCE(Double,Vec4D)+instance (Fold a v, PackedVec v) => Fold a (Packed v) + where+ fold f = fold f . unpack+ foldl f z = foldl f z . unpack+ foldr f z = foldr f z . unpack+ {-# INLINE fold #-}+ {-# INLINE foldl #-}+ {-# INLINE foldr #-} -#define ZIPWITH_INSTANCE(S,V) \-instance ZipWith S S S V V V where \+instance (ZipWith a b c u v w, PackedVec u, PackedVec v, PackedVec w)+ => ZipWith a b c (Packed u) (Packed v) (Packed w)+ where zipWith f u v = pack $ zipWith f (unpack u) (unpack v)+ {-# INLINE zipWith #-} -ZIPWITH_INSTANCE(Int,Vec2I)-ZIPWITH_INSTANCE(Int,Vec3I)-ZIPWITH_INSTANCE(Int,Vec4I)-ZIPWITH_INSTANCE(Float,Vec2F)-ZIPWITH_INSTANCE(Float,Vec3F)-ZIPWITH_INSTANCE(Float,Vec4F)-ZIPWITH_INSTANCE(Double,Vec2D)-ZIPWITH_INSTANCE(Double,Vec3D)-ZIPWITH_INSTANCE(Double,Vec4D)+instance (Num v, PackedVec v) => Num (Packed v) + where+ (+) u v = pack (unpack u + unpack v) + (-) u v = pack (unpack u - unpack v)+ (*) u v = pack (unpack u * unpack v)+ abs u = pack (abs (unpack u))+ signum u = pack (signum (unpack u))+ fromInteger i = pack (fromInteger i)+ {-# INLINE (+) #-}+ {-# INLINE (-) #-}+ {-# INLINE (*) #-}+ {-# INLINE abs #-}+ {-# INLINE signum #-}+ {-# INLINE fromInteger #-}+ +instance (Fractional v, PackedVec v) => Fractional (Packed v)+ where+ (/) u v = pack (unpack u / unpack v)+ recip u = pack (recip (unpack u))+ fromRational r = pack (fromRational r)+ {-# INLINE (/) #-}+ {-# INLINE recip #-}+ {-# INLINE fromRational #-} +instance (Storable v, PackedVec v) => Storable (Packed v)+ where+ sizeOf _ = sizeOf (undefined::v)+ alignment _ = alignment (undefined::v)+ peek p = peek (castPtr p) >>= \v -> return (pack v)+ peekByteOff p o = peek (p`plusPtr`o)+ peekElemOff p i = peek (p`plusPtr`(i*sizeOf(undefined::v)))+ poke p v = poke (castPtr p) (unpack v)+ pokeByteOff p o x = poke (p`plusPtr`o) x+ pokeElemOff p i x = poke (p`plusPtr`(i*sizeOf(undefined::v))) x+ {-# INLINE sizeOf #-}+ {-# INLINE alignment #-}+ {-# INLINE peek #-}+ {-# INLINE peekByteOff #-}+ {-# INLINE peekElemOff #-}+ {-# INLINE poke #-}+ {-# INLINE pokeByteOff #-}+ {-# INLINE pokeElemOff #-} -#define NUM_INSTANCE(V) \-instance Num V where \- u + v = pack $ unpack u + unpack v ; \- u - v = pack $ unpack u + unpack v ; \- u * v = pack $ unpack u * unpack v ; \- abs = pack . abs . unpack ; \- signum = pack . signum . unpack ; \- fromInteger = pack . fromInteger -NUM_INSTANCE(Vec2I)-NUM_INSTANCE(Vec3I)-NUM_INSTANCE(Vec4I)-NUM_INSTANCE(Vec2F)-NUM_INSTANCE(Vec3F)-NUM_INSTANCE(Vec4F)-NUM_INSTANCE(Vec2D)-NUM_INSTANCE(Vec3D)-NUM_INSTANCE(Vec4D)+instance (Arbitrary v, PackedVec v) => Arbitrary (Packed v)+ where+ arbitrary = arbitrary >>= return . pack+ coarbitrary v = coarbitrary (unpack v) -#define FRACTIONAL_INSTANCE(V) \-instance Fractional V where \- u / v = pack $ unpack u / unpack v ;\- recip = pack . recip . unpack ;\- fromRational = pack . fromRational -FRACTIONAL_INSTANCE(Vec2F)-FRACTIONAL_INSTANCE(Vec3F)-FRACTIONAL_INSTANCE(Vec4F)-FRACTIONAL_INSTANCE(Vec2D)-FRACTIONAL_INSTANCE(Vec3D)-FRACTIONAL_INSTANCE(Vec4D) +instance (Length v n, PackedVec v) => Length (Packed v) n+ where+ length v = length (unpack v)+ {-# INLINE length #-} -#define STORABLE_INSTANCE(V,PV) \-instance Storable PV where \- sizeOf = sizeOf.unpack ;\- alignment = alignment.unpack ;\- peek p = peek (castPtr p) >>= return.pack ;\- poke p v = poke (castPtr p) (unpack v) ;\- peekElemOff p i = peekElemOff (castPtr p) i >>= return.pack ;\- pokeElemOff p i v = pokeElemOff (castPtr p) i (unpack v) ;\- peekByteOff p b = peekByteOff (castPtr p) b >>= return.pack ;\- pokeByteOff p b v = pokeByteOff (castPtr p) b (unpack v) ;\+instance (Head v h, PackedVec v) => Head (Packed v) h+ where+ head v = head (unpack v)+ {-# INLINE head #-} -STORABLE_INSTANCE(Vec2 Int,Vec2I)-STORABLE_INSTANCE(Vec3 Int,Vec3I)-STORABLE_INSTANCE(Vec4 Int,Vec4I)-STORABLE_INSTANCE(Vec2 Float,Vec2F)-STORABLE_INSTANCE(Vec3 Float,Vec3F)-STORABLE_INSTANCE(Vec4 Float,Vec4F)-STORABLE_INSTANCE(Vec2 Double,Vec2D)-STORABLE_INSTANCE(Vec3 Double,Vec3D)-STORABLE_INSTANCE(Vec4 Double,Vec4D)+instance (Tail v t, PackedVec v, PackedVec t) => Tail (Packed v) (Packed t)+ where + tail v = pack (tail (unpack v))+ {-# INLINE tail #-} +instance (Last v l, PackedVec v) => Last (Packed v) l+ where+ last v = last (unpack v)+ {-# INLINE last #-}++instance (Snoc v a v', PackedVec v, PackedVec v') + => Snoc (Packed v) a (Packed v')+ where+ snoc v a = pack (snoc (unpack v) a)+ {-# INLINE snoc #-}++instance (Reverse' () v v', PackedVec v, PackedVec v') + => Reverse' () (Packed v) (Packed v')+ where+ reverse' _ v = pack (reverse (unpack v))+ {-# INLINE reverse' #-}++instance (Take (Succ n) v v', PackedVec v, PackedVec v') + => Take (Succ n) (Packed v) (Packed v')+ where+ take n v = pack (take n (unpack v))+ {-# INLINE take #-}++instance (Drop n v v', PackedVec v, PackedVec v') + => Drop n (Packed v) (Packed v')+ where+ drop n v = pack (drop n (unpack v))+ {-# INLINE drop #-}
Vec.cabal view
@@ -1,5 +1,5 @@ Name: Vec-Version: 0.9.1+Version: 0.9.2 License: BSD3 License-file: LICENSE Author: Scott E. Dillard@@ -19,7 +19,7 @@ Category: Data,Math library- Build-Depends: base+ Build-Depends: base,QuickCheck Exposed-modules: Data.Vec Data.Vec.Base,@@ -39,4 +39,5 @@ ScopedTypeVariables, TypeOperators, TypeSynonymInstances,+ TypeFamilies, UndecidableInstances