tup-functor 0.2.0.3 → 0.3.0.0

raw patch · 13 files changed

+807/−402 lines, 13 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Tup.hs +5/−1
• Data/Tup/Class.hs +121/−0
• Data/Tup/Concat.hs +249/−0
• Data/Tup/Newtype.hs +306/−0
• Data/Tup/Tup.hs +4/−5
• Data/Tup/Tup/Class.hs +0/−77
• Data/Tup/Tup/Concat.hs +0/−164
• Data/Tup/Tup/Lazy.hs +1/−0
• Data/Tup/Tup/Strict.hs +1/−0
• Data/Tup/Tup/Tup.inc +11/−11
• Data/Tup/Vec.hs +58/−119
• preprocessor/tpp.hs +43/−18
• tup-functor.cabal +8/−7

@@ -6,7 +6,8 @@ -- >   tupSize     :: f a -> Int
 -- >   tupToList   :: f a -> [a]
 -- >   tupFromList :: [a] -> f a 
--- >   tupUndef    :: f a -> a
+-- >   tupProxy    :: f a -> Proxy a
+-- >   ...
 --
 -- Also included is a very simple preprocesszor @tuplepp@ which translates
 -- the syntax @\{\{a,b,c\}\}@ into @(Tup3 a b c)@.
@@ -14,6 +15,9 @@ -- A different implementation is also given in the module "Data.Tup.Vec"; this basically implements
 -- lists which encode their length in their types. For this, just replace 'Tup' by 'Vec' everywhere.
 -- The same instances and functions are provided.
+--
+-- A third implementation is in "Data.Tup.Newtype"; here the tuples are newtypes of Haskell tuples.
+-- Just replace 'Tup' by 'NTup'.
 --
 
 module Data.Tup ( module Data.Tup.Tup )  where

@@ -0,0 +1,121 @@+
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+module Data.Tup.Class where
+
+--------------------------------------------------------------------------------
+
+import Control.Applicative
+
+import Data.Foldable    (Foldable)
+import Data.Traversable (Traversable)
+
+import qualified Data.Foldable    as Foldable
+import qualified Data.Traversable as Traversable
+
+import Data.List
+import Data.Proxy
+
+--------------------------------------------------------------------------------
+-- * the Tup class
+
+class (Functor f, Applicative f, Foldable f, Traversable f) => Tup f where
+
+  tupSize      :: f a -> Int         -- ^ equivalent to @length . tupToList@
+  tupToList    :: f a -> [a]         -- ^ equivalent to @Foldable.toList@
+  tupFromList  :: [a] -> f a  
+
+  tupProxy     :: f a -> Proxy a
+  tupUndef     :: f a -> a           -- ^ poor man\'s version of 'tupProxy'
+
+  constantTup  :: a -> f a  
+  undefinedTup :: f a                -- ^ when possible \/ makes sense, you can still pattern-patch on the constructor 
+
+  tupSize      = Foldable.foldl (\c _ -> c+1) 0 
+  tupToList    = Foldable.toList
+  tupFromList  = \ys -> snd $ Traversable.mapAccumL (\(x:xs) _ -> (xs,x)) ys (pure undefined)
+
+  tupUndef _   = undefined
+  tupProxy _   = Proxy
+
+  constantTup  = pure
+  undefinedTup = pure undefined
+
+{-
+-- | temporary, for testing
+testTupFromList :: (Applicative f, Traversable f) => [a] -> f a
+testTupFromList ys = snd $ Traversable.mapAccumL (\(x:xs) _ -> (xs,x)) ys (pure undefined)
+-}
+
+--------------------------------------------------------------------------------
+-- * Misc 
+
+-- | Safe version of 'tupFromList'.
+maybeTupFromList :: Tup f => [a] -> Maybe (f a)
+maybeTupFromList xs = result where
+  result = if length xs == tupSize (undef result) 
+    then Just (tupFromList xs)
+    else Nothing    
+  undef :: Maybe a -> a
+  undef _ = undefined
+
+-- | Transpose a Tup of Tups.
+transposeTup :: (Tup f, Tup g) => f (g a) -> g (f a)
+transposeTup = tupFromList . (map tupFromList) . transpose . (map tupToList) . tupToList
+
+--------------------------------------------------------------------------------
+-- * Concatenation
+
+-- | Safe concatenation (going through lists)
+maybeTupConcat :: (Tup f, Tup g, Tup h) => f a -> g a -> Maybe (h a)
+maybeTupConcat x y = 
+  if tupSize x + tupSize y == tupSize z 
+    then Just z
+    else Nothing  
+  where
+    z = tupFromList (tupToList x ++ tupToList y)
+
+-- | Unsafe concatenation
+unsafeTupConcat :: (Tup f, Tup g, Tup h) => f a -> g a -> h a
+unsafeTupConcat x y = z
+  where
+    z = tupFromList (tupToList x ++ tupToList y)
+
+--------------------------------------------------------------------------------
+-- * Conversion
+
+-- | Safe conversion between different Tup implementations
+maybeConvertTup ::  (Tup f, Tup g) => f a -> Maybe (g a)
+maybeConvertTup x =
+  if tupSize x == tupSize y 
+    then Just y
+    else Nothing  
+  where
+    y = tupFromList (tupToList x)
+
+-- | Unsafe conversion
+unsafeConvertTup :: (Tup f, Tup g) => f a -> g a
+unsafeConvertTup x = tupFromList (tupToList x)
+
+--------------------------------------------------------------------------------
+-- * zipping (only using the Applicative structure)
+
+zipTupWith :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
+zipTupWith f t1 t2 = f <$> t1 <*> t2
+
+zipTupWith3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
+zipTupWith3 f t1 t2 t3 = f <$> t1 <*> t2 <*> t3
+
+zipTupWith4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
+zipTupWith4 f t1 t2 t3 t4 = f <$> t1 <*> t2 <*> t3 <*> t4
+
+zipTup :: Applicative f => f a -> f b -> f (a,b)
+zipTup t1 t2 = (,) <$> t1 <*> t2
+
+zipTup3 :: Applicative f => f a -> f b -> f c -> f (a,b,c)
+zipTup3 t1 t2 t3 = (,,) <$> t1 <*> t2 <*> t3
+
+zipTup4 :: Applicative f => f a -> f b -> f c -> f d -> f (a,b,c,d)
+zipTup4 t1 t2 t3 t4 = (,,,) <$> t1 <*> t2 <*> t3 <*> t4
+
+--------------------------------------------------------------------------------
+

@@ -0,0 +1,249 @@++-- | Concatenation of tuples. Requires MPTCs and FunDeps. ++{-# OPTIONS_GHC -cpp -pgmPcpphs -optP--cpp -optP-ansi -optP--hashes #-}+{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances #-}++module Data.Tup.Concat where++--------------------------------------------------------------------------------++import Data.Tup.Class++import qualified Data.Tup.Tup.Lazy   as L+import qualified Data.Tup.Tup.Strict as S+import qualified Data.Tup.Vec        as V+import qualified Data.Tup.Newtype    as N++--------------------------------------------------------------------------------++class (Tup f, Tup g, Tup h) => TupConcat f g h | f g -> h where+  tupConcat :: f a -> g a -> h a+  tupConcat x y = tupFromList (tupToList x ++ tupToList y)++--------------------------------------------------------------------------------+-- Vecs++instance Tup v => TupConcat V.Empty v v where+  tupConcat V.Empty v = v++-- This seems to need UndecidableInstances?+instance (Tup u, Tup v, TupConcat u v w) => TupConcat (V.Cons u) v (V.Cons w) where+  tupConcat (V.Cons x u) v = V.Cons x (tupConcat u v)++--------------------------------------------------------------------------------++#define TUPCONCAT_L(A,B,C) \+instance TupConcat L.Tup##A L.Tup##B L.Tup##C ++#define TUPCONCAT_S(A,B,C) \+instance TupConcat S.Tup##A S.Tup##B S.Tup##C ++#define TUPCONCAT_N(A,B,C) \+instance TupConcat N.NTup##A N.NTup##B N.NTup##C ++--------------------------------------------------------------------------------+-- lazy Tups++TUPCONCAT_L(0,0,0)+TUPCONCAT_L(0,1,1)+TUPCONCAT_L(0,2,2)+TUPCONCAT_L(0,3,3)+TUPCONCAT_L(0,4,4)+TUPCONCAT_L(0,5,5)+TUPCONCAT_L(0,6,6)+TUPCONCAT_L(0,7,7)+TUPCONCAT_L(0,8,8)+TUPCONCAT_L(0,9,9)++TUPCONCAT_L(1,0,1)+TUPCONCAT_L(1,1,2)+TUPCONCAT_L(1,2,3)+TUPCONCAT_L(1,3,4)+TUPCONCAT_L(1,4,5)+TUPCONCAT_L(1,5,6)+TUPCONCAT_L(1,6,7)+TUPCONCAT_L(1,7,8)+TUPCONCAT_L(1,8,9)++TUPCONCAT_L(2,0,2)+TUPCONCAT_L(2,1,3)+TUPCONCAT_L(2,2,4)+TUPCONCAT_L(2,3,5)+TUPCONCAT_L(2,4,6)+TUPCONCAT_L(2,5,7)+TUPCONCAT_L(2,6,8)+TUPCONCAT_L(2,7,9)++TUPCONCAT_L(3,0,3)+TUPCONCAT_L(3,1,4)+TUPCONCAT_L(3,2,5)+TUPCONCAT_L(3,3,6)+TUPCONCAT_L(3,4,7)+TUPCONCAT_L(3,5,8)+TUPCONCAT_L(3,6,9)++TUPCONCAT_L(4,0,4)+TUPCONCAT_L(4,1,5)+TUPCONCAT_L(4,2,6)+TUPCONCAT_L(4,3,7)+TUPCONCAT_L(4,4,8)+TUPCONCAT_L(4,5,9)++TUPCONCAT_L(5,0,5)+TUPCONCAT_L(5,1,6)+TUPCONCAT_L(5,2,7)+TUPCONCAT_L(5,3,8)+TUPCONCAT_L(5,4,9)++TUPCONCAT_L(6,0,6)+TUPCONCAT_L(6,1,7)+TUPCONCAT_L(6,2,8)+TUPCONCAT_L(6,3,9)++TUPCONCAT_L(7,0,7)+TUPCONCAT_L(7,1,8)+TUPCONCAT_L(7,2,9)++TUPCONCAT_L(8,0,8)+TUPCONCAT_L(8,1,9)++TUPCONCAT_L(9,0,9)++--------------------------------------------------------------------------------+-- strict Tups++TUPCONCAT_S(0,0,0)+TUPCONCAT_S(0,1,1)+TUPCONCAT_S(0,2,2)+TUPCONCAT_S(0,3,3)+TUPCONCAT_S(0,4,4)+TUPCONCAT_S(0,5,5)+TUPCONCAT_S(0,6,6)+TUPCONCAT_S(0,7,7)+TUPCONCAT_S(0,8,8)+TUPCONCAT_S(0,9,9)++TUPCONCAT_S(1,0,1)+TUPCONCAT_S(1,1,2)+TUPCONCAT_S(1,2,3)+TUPCONCAT_S(1,3,4)+TUPCONCAT_S(1,4,5)+TUPCONCAT_S(1,5,6)+TUPCONCAT_S(1,6,7)+TUPCONCAT_S(1,7,8)+TUPCONCAT_S(1,8,9)++TUPCONCAT_S(2,0,2)+TUPCONCAT_S(2,1,3)+TUPCONCAT_S(2,2,4)+TUPCONCAT_S(2,3,5)+TUPCONCAT_S(2,4,6)+TUPCONCAT_S(2,5,7)+TUPCONCAT_S(2,6,8)+TUPCONCAT_S(2,7,9)++TUPCONCAT_S(3,0,3)+TUPCONCAT_S(3,1,4)+TUPCONCAT_S(3,2,5)+TUPCONCAT_S(3,3,6)+TUPCONCAT_S(3,4,7)+TUPCONCAT_S(3,5,8)+TUPCONCAT_S(3,6,9)++TUPCONCAT_S(4,0,4)+TUPCONCAT_S(4,1,5)+TUPCONCAT_S(4,2,6)+TUPCONCAT_S(4,3,7)+TUPCONCAT_S(4,4,8)+TUPCONCAT_S(4,5,9)++TUPCONCAT_S(5,0,5)+TUPCONCAT_S(5,1,6)+TUPCONCAT_S(5,2,7)+TUPCONCAT_S(5,3,8)+TUPCONCAT_S(5,4,9)++TUPCONCAT_S(6,0,6)+TUPCONCAT_S(6,1,7)+TUPCONCAT_S(6,2,8)+TUPCONCAT_S(6,3,9)++TUPCONCAT_S(7,0,7)+TUPCONCAT_S(7,1,8)+TUPCONCAT_S(7,2,9)++TUPCONCAT_S(8,0,8)+TUPCONCAT_S(8,1,9)++TUPCONCAT_S(9,0,9)++--------------------------------------------------------------------------------+-- NTups++TUPCONCAT_N(0,0,0)+TUPCONCAT_N(0,1,1)+TUPCONCAT_N(0,2,2)+TUPCONCAT_N(0,3,3)+TUPCONCAT_N(0,4,4)+TUPCONCAT_N(0,5,5)+TUPCONCAT_N(0,6,6)+TUPCONCAT_N(0,7,7)+TUPCONCAT_N(0,8,8)+TUPCONCAT_N(0,9,9)++TUPCONCAT_N(1,0,1)+TUPCONCAT_N(1,1,2)+TUPCONCAT_N(1,2,3)+TUPCONCAT_N(1,3,4)+TUPCONCAT_N(1,4,5)+TUPCONCAT_N(1,5,6)+TUPCONCAT_N(1,6,7)+TUPCONCAT_N(1,7,8)+TUPCONCAT_N(1,8,9)++TUPCONCAT_N(2,0,2)+TUPCONCAT_N(2,1,3)+TUPCONCAT_N(2,2,4)+TUPCONCAT_N(2,3,5)+TUPCONCAT_N(2,4,6)+TUPCONCAT_N(2,5,7)+TUPCONCAT_N(2,6,8)+TUPCONCAT_N(2,7,9)++TUPCONCAT_N(3,0,3)+TUPCONCAT_N(3,1,4)+TUPCONCAT_N(3,2,5)+TUPCONCAT_N(3,3,6)+TUPCONCAT_N(3,4,7)+TUPCONCAT_N(3,5,8)+TUPCONCAT_N(3,6,9)++TUPCONCAT_N(4,0,4)+TUPCONCAT_N(4,1,5)+TUPCONCAT_N(4,2,6)+TUPCONCAT_N(4,3,7)+TUPCONCAT_N(4,4,8)+TUPCONCAT_N(4,5,9)++TUPCONCAT_N(5,0,5)+TUPCONCAT_N(5,1,6)+TUPCONCAT_N(5,2,7)+TUPCONCAT_N(5,3,8)+TUPCONCAT_N(5,4,9)++TUPCONCAT_N(6,0,6)+TUPCONCAT_N(6,1,7)+TUPCONCAT_N(6,2,8)+TUPCONCAT_N(6,3,9)++TUPCONCAT_N(7,0,7)+TUPCONCAT_N(7,1,8)+TUPCONCAT_N(7,2,9)++TUPCONCAT_N(8,0,8)+TUPCONCAT_N(8,1,9)++TUPCONCAT_N(9,0,9)++--------------------------------------------------------------------------------

@@ -0,0 +1,306 @@+
+-- | Homogeneous tuples as newtypes of standard Haskell tuples.
+-- This is a third alternative implementation.
+--
+-- > ntup3 1 2 3 == NTup3 (1,2,3)
+--
+
+{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable, GeneralizedNewtypeDeriving #-}
+module Data.Tup.Newtype where
+
+--------------------------------------------------------------------------------
+
+import Control.Applicative
+
+import Data.List
+import Data.Foldable
+import Data.Traversable
+import Data.Monoid
+
+import Foreign.Ptr
+import Foreign.Storable
+import Foreign.Marshal
+
+import Data.Tup.Class
+
+--------------------------------------------------------------------------------
+-- * newtyped tuples
+
+data    NTup0 a = NTup0                     deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup1 a = NTup1  a                  deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup2 a = NTup2 (a,a)               deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup3 a = NTup3 (a,a,a)             deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup4 a = NTup4 (a,a,a,a)           deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup5 a = NTup5 (a,a,a,a,a)         deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup6 a = NTup6 (a,a,a,a,a,a)       deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup7 a = NTup7 (a,a,a,a,a,a,a)     deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup8 a = NTup8 (a,a,a,a,a,a,a,a)   deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+newtype NTup9 a = NTup9 (a,a,a,a,a,a,a,a,a) deriving (Eq,Ord,Read,Show,Bounded,Functor,Foldable,Traversable)
+
+--------------------------------------------------------------------------------
+-- * constructing NTups
+
+ntup0 :: NTup0 a
+ntup0 = NTup0
+
+ntup1 :: a -> NTup1 a
+ntup1 x1 = NTup1 x1
+
+ntup2 :: a -> a -> NTup2 a
+ntup2 x1 x2 = NTup2 (x1,x2)
+
+ntup3 :: a -> a -> a -> NTup3 a
+ntup3 x1 x2 x3 = NTup3 (x1,x2,x3)
+
+ntup4 :: a -> a -> a -> a -> NTup4 a
+ntup4 x1 x2 x3 x4 = NTup4 (x1,x2,x3,x4)
+
+ntup5 :: a -> a -> a -> a -> a -> NTup5 a
+ntup5 x1 x2 x3 x4 x5 = NTup5 (x1,x2,x3,x4,x5)
+
+ntup6 :: a -> a -> a -> a -> a -> a -> NTup6 a
+ntup6 x1 x2 x3 x4 x5 x6 = NTup6 (x1,x2,x3,x4,x5,x6)
+
+ntup7 :: a -> a -> a -> a -> a -> a -> a -> NTup7 a
+ntup7 x1 x2 x3 x4 x5 x6 x7 = NTup7 (x1,x2,x3,x4,x5,x6,x7)
+
+ntup8 :: a -> a -> a -> a -> a -> a -> a -> a -> NTup8 a
+ntup8 x1 x2 x3 x4 x5 x6 x7 x8 = NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)
+
+ntup9 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> NTup9 a
+ntup9 x1 x2 x3 x4 x5 x6 x7 x8 x9 = NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)
+
+--------------------------------------------------------------------------------
+-- * deconstructing NTups
+
+untup1 :: NTup1 a -> a
+untup1 (NTup1 t) = t
+
+untup2 :: NTup2 a -> (a,a)
+untup2 (NTup2 t) = t
+
+untup3 :: NTup3 a -> (a,a,a)
+untup3 (NTup3 t) = t
+
+untup4 :: NTup4 a -> (a,a,a,a)
+untup4 (NTup4 t) = t
+
+untup5 :: NTup5 a -> (a,a,a,a,a)
+untup5 (NTup5 t) = t
+
+untup6 :: NTup6 a -> (a,a,a,a,a,a)
+untup6 (NTup6 t) = t
+
+untup7 :: NTup7 a -> (a,a,a,a,a,a,a)
+untup7 (NTup7 t) = t
+
+untup8 :: NTup8 a -> (a,a,a,a,a,a,a,a)
+untup8 (NTup8 t) = t
+
+untup9 :: NTup9 a -> (a,a,a,a,a,a,a,a,a)
+untup9 (NTup9 t) = t
+
+--------------------------------------------------------------------------------
+
+instance Tup NTup0 where
+  tupSize   _    = 0
+  tupToList _    = []
+  tupFromList [] = NTup0
+  tupFromList _  = error "tupFromList: list should have length 0"
+
+instance Tup NTup1 where
+  tupSize _ = 1
+  tupToList (NTup1 x1) = [x1]
+  tupFromList [x1] = NTup1 x1
+  tupFromList _ = error "tupFromList: list should have length 1"
+
+instance Tup NTup2 where
+  tupSize _ = 2
+  tupToList (NTup2 (x1,x2)) = [x1,x2]
+  tupFromList [x1,x2] = NTup2 (x1,x2)
+  tupFromList _ = error "tupFromList: list should have length 2"
+
+instance Tup NTup3 where
+  tupSize _ = 3
+  tupToList (NTup3 (x1,x2,x3)) = [x1,x2,x3]
+  tupFromList [x1,x2,x3] = NTup3 (x1,x2,x3)
+  tupFromList _ = error "tupFromList: list should have length 3"
+
+instance Tup NTup4 where
+  tupSize _ = 4
+  tupToList (NTup4 (x1,x2,x3,x4)) = [x1,x2,x3,x4]
+  tupFromList [x1,x2,x3,x4] = NTup4 (x1,x2,x3,x4)
+  tupFromList _ = error "tupFromList: list should have length 4"
+
+instance Tup NTup5 where
+  tupSize _ = 5
+  tupToList (NTup5 (x1,x2,x3,x4,x5)) = [x1,x2,x3,x4,x5]
+  tupFromList [x1,x2,x3,x4,x5] = NTup5 (x1,x2,x3,x4,x5)
+  tupFromList _ = error "tupFromList: list should have length 5"
+
+instance Tup NTup6 where
+  tupSize _ = 6
+  tupToList (NTup6 (x1,x2,x3,x4,x5,x6)) = [x1,x2,x3,x4,x5,x6]
+  tupFromList [x1,x2,x3,x4,x5,x6] = NTup6 (x1,x2,x3,x4,x5,x6)
+  tupFromList _ = error "tupFromList: list should have length 6"
+
+instance Tup NTup7 where
+  tupSize _ = 7
+  tupToList (NTup7 (x1,x2,x3,x4,x5,x6,x7)) = [x1,x2,x3,x4,x5,x6,x7]
+  tupFromList [x1,x2,x3,x4,x5,x6,x7] = NTup7 (x1,x2,x3,x4,x5,x6,x7)
+  tupFromList _ = error "tupFromList: list should have length 7"
+
+instance Tup NTup8 where
+  tupSize _ = 8
+  tupToList (NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)) = [x1,x2,x3,x4,x5,x6,x7,x8]
+  tupFromList [x1,x2,x3,x4,x5,x6,x7,x8] = NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)
+  tupFromList _ = error "tupFromList: list should have length 8"
+
+instance Tup NTup9 where
+  tupSize _ = 9
+  tupToList (NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)) = [x1,x2,x3,x4,x5,x6,x7,x8,x9]
+  tupFromList [x1,x2,x3,x4,x5,x6,x7,x8,x9] = NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)
+  tupFromList _ = error "tupFromList: list should have length 9"
+
+--------------------------------------------------------------------------------
+
+instance Applicative NTup0 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure _ = NTup0
+  NTup0 <*> NTup0 = NTup0
+
+instance Applicative NTup1 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup1 x
+  NTup1 f1 <*> NTup1 x1 = NTup1 (f1 x1)
+
+instance Applicative NTup2 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup2 (x,x)
+  NTup2 (f1,f2) <*> NTup2 (x1,x2) = NTup2 (f1 x1, f2 x2)
+
+instance Applicative NTup3 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup3 (x,x,x)
+  NTup3 (f1,f2,f3) <*> NTup3 (x1,x2,x3) = NTup3 (f1 x1, f2 x2, f3 x3)
+
+instance Applicative NTup4 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup4 (x,x,x,x)
+  NTup4 (f1,f2,f3,f4) <*> NTup4 (x1,x2,x3,x4) = NTup4 (f1 x1, f2 x2, f3 x3, f4 x4)
+
+instance Applicative NTup5 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup5 (x,x,x,x,x)
+  NTup5 (f1,f2,f3,f4,f5) <*> NTup5 (x1,x2,x3,x4,x5) = NTup5 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5)
+
+instance Applicative NTup6 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup6 (x,x,x,x,x,x)
+  NTup6 (f1,f2,f3,f4,f5,f6) <*> NTup6 (x1,x2,x3,x4,x5,x6) = NTup6 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6)
+
+instance Applicative NTup7 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup7 (x,x,x,x,x,x,x)
+  NTup7 (f1,f2,f3,f4,f5,f6,f7) <*> NTup7 (x1,x2,x3,x4,x5,x6,x7) 
+    = NTup7 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6, f7 x7)
+
+instance Applicative NTup8 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup8 (x,x,x,x,x,x,x,x)
+  NTup8 (f1,f2,f3,f4,f5,f6,f7,f8) <*> NTup8 (x1,x2,x3,x4,x5,x6,x7,x8)
+    = NTup8 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6, f7 x7, f8 x8)
+
+instance Applicative NTup9 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = NTup9 (x,x,x,x,x,x,x,x,x)
+  NTup9 (f1,f2,f3,f4,f5,f6,f7,f8,f9) <*> NTup9 (x1,x2,x3,x4,x5,x6,x7,x8,x9)
+    = NTup9 (f1 x1, f2 x2, f3 x3, f4 x4, f5 x5, f6 x6, f7 x7, f8 x8, f9 x9)
+
+--------------------------------------------------------------------------------
+
+#define NUM_INSTANCE                   \
+  { t1 + t2 = (+) <$> t1 <*> t2        \
+  ; t1 - t2 = (-) <$> t1 <*> t2        \
+  ; t1 * t2 = (*) <$> t1 <*> t2        \
+  ; abs    = fmap abs                  \
+  ; signum = fmap signum               \
+  ; fromInteger = pure . fromInteger }
+
+instance Num a => Num (NTup0 a) where NUM_INSTANCE
+instance Num a => Num (NTup1 a) where NUM_INSTANCE
+instance Num a => Num (NTup2 a) where NUM_INSTANCE
+instance Num a => Num (NTup3 a) where NUM_INSTANCE
+instance Num a => Num (NTup4 a) where NUM_INSTANCE
+instance Num a => Num (NTup5 a) where NUM_INSTANCE
+instance Num a => Num (NTup6 a) where NUM_INSTANCE
+instance Num a => Num (NTup7 a) where NUM_INSTANCE
+instance Num a => Num (NTup8 a) where NUM_INSTANCE
+instance Num a => Num (NTup9 a) where NUM_INSTANCE
+
+--------------------------------------------------------------------------------
+
+#define FRACTIONAL_INSTANCE              \
+  { t1 / t2 = (/) <$> t1 <*> t2          \
+  ; recip   = fmap recip                 \
+  ; fromRational = pure . fromRational }
+
+instance Fractional a => Fractional (NTup0 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup1 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup2 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup3 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup4 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup5 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup6 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup7 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup8 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (NTup9 a) where FRACTIONAL_INSTANCE
+
+--------------------------------------------------------------------------------
+
+#define MONOID_INSTANCE                     \
+  { mempty = pure mempty                    \
+  ; mappend t1 t2 = mappend <$> t1 <*> t2 } 
+
+instance Monoid a => Monoid (NTup0 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup1 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup2 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup3 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup4 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup5 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup6 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup7 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup8 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (NTup9 a) where MONOID_INSTANCE
+
+--------------------------------------------------------------------------------
+
+#define STORABLE_INSTANCE                                 \
+  { sizeOf    t = tupSize t * sizeOf (tupUndef t)         \
+  ; alignment t = alignment (tupUndef t)                  \
+  ; peek ptr    = let { ptrUndef :: Ptr b -> b ; ptrUndef _ = undefined }              \
+                  in  tupFromList <$> peekArray (tupSize $ ptrUndef ptr) (castPtr ptr) \
+  ; poke ptr t  = pokeArray (castPtr ptr) (tupToList t) }
+
+instance Storable a => Storable (NTup0 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup1 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup2 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup3 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup4 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup5 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup6 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup7 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup8 a) where STORABLE_INSTANCE
+instance Storable a => Storable (NTup9 a) where STORABLE_INSTANCE
+
+--------------------------------------------------------------------------------

@@ -6,21 +6,20 @@ -- >   tupSize     :: f a -> Int
 -- >   tupToList   :: f a -> [a]
 -- >   tupFromList :: [a] -> f a 
--- >   tupUndef    :: f a -> a
+-- >   tupProxy    :: f a -> Proxy a
+-- >   ...
 --
 -- Also included is a very simple preprocesszor @tuplepp@ which translates
 -- the syntax @\{\{a,b,c\}\}@ into @(Tup3 a b c)@.
 --
 
 module Data.Tup.Tup
-  ( module Data.Tup.Tup.Class
+  ( module Data.Tup.Class
   , module Data.Tup.Tup.Lazy 
-  , module Data.Tup.Tup.Concat
   ) 
   where
 
 import Control.Applicative ( Applicative )     -- only for Haddock
 
-import Data.Tup.Tup.Class
+import Data.Tup.Class
 import Data.Tup.Tup.Lazy
-import Data.Tup.Tup.Concat

@@ -1,77 +0,0 @@-
-module Data.Tup.Tup.Class where
-
---------------------------------------------------------------------------------
-
-import Control.Applicative
-import Data.Foldable (Foldable)
-import Data.Traversable (Traversable)
-
-import Data.List
-
---------------------------------------------------------------------------------
--- * the Tup class
-
-class (Functor f, Applicative f, Foldable f, Traversable f) => Tup f where
-  tupSize     :: f a -> Int
-  tupToList   :: f a -> [a]
-  tupFromList :: [a] -> f a
-
-  tupUndef    :: f a -> a
-  tupUndef     = undefined
-
---------------------------------------------------------------------------------
--- * misc 
-
--- | Safe version of 'tupFromList'.
-maybeTupFromList :: Tup f => [a] -> Maybe (f a)
-maybeTupFromList xs = result where
-  result = if length xs == tupSize (undef result) 
-    then Just (tupFromList xs)
-    else Nothing    
-  undef :: Maybe a -> a
-  undef _ = undefined
-
--- | Transpose a Tup of Tups.
-transposeTup :: (Tup f, Tup g) => f (g a) -> g (f a)
-transposeTup = tupFromList . (map tupFromList) . transpose . (map tupToList) . tupToList
-
---------------------------------------------------------------------------------
-
--- | Concatenation
-maybeTupConcat :: (Tup f, Tup g, Tup h) => f a -> g a -> Maybe (h a)
-maybeTupConcat x y = 
-  if tupSize x + tupSize y == tupSize z 
-    then Just z
-    else Nothing  
-  where
-    z = tupFromList (tupToList x ++ tupToList y)
-
-unsafeTupConcat :: (Tup f, Tup g, Tup h) => f a -> g a -> h a
-unsafeTupConcat x y = z
-  where
-    z = tupFromList (tupToList x ++ tupToList y)
-
---------------------------------------------------------------------------------
--- * zipping 
-
-zipTupWith :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
-zipTupWith f t1 t2 = f <$> t1 <*> t2
-
-zipTupWith3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
-zipTupWith3 f t1 t2 t3 = f <$> t1 <*> t2 <*> t3
-
-zipTupWith4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
-zipTupWith4 f t1 t2 t3 t4 = f <$> t1 <*> t2 <*> t3 <*> t4
-
-zipTup :: Applicative f => f a -> f b -> f (a,b)
-zipTup t1 t2 = (,) <$> t1 <*> t2
-
-zipTup3 :: Applicative f => f a -> f b -> f c -> f (a,b,c)
-zipTup3 t1 t2 t3 = (,,) <$> t1 <*> t2 <*> t3
-
-zipTup4 :: Applicative f => f a -> f b -> f c -> f d -> f (a,b,c,d)
-zipTup4 t1 t2 t3 t4 = (,,,) <$> t1 <*> t2 <*> t3 <*> t4
-
---------------------------------------------------------------------------------
-

@@ -1,164 +0,0 @@---- | Concatenation of tuples. Requires MPTCs and FunDeps. --{-# OPTIONS_GHC -cpp -pgmPcpphs -optP--cpp -optP-ansi -optP--hashes #-}-{-# LANGUAGE CPP, MultiParamTypeClasses, FunctionalDependencies #-}-module Data.Tup.Tup.Concat where------------------------------------------------------------------------------------import Data.Tup.Tup.Class--import qualified Data.Tup.Tup.Lazy   as L-import qualified Data.Tup.Tup.Strict as S------------------------------------------------------------------------------------class (Tup f, Tup g, Tup h) => TupConcat f g h | f g -> h where-  tupConcat :: f a -> g a -> h a-  tupConcat x y = tupFromList (tupToList x ++ tupToList y)------------------------------------------------------------------------------------#define TUPCONCAT_L(A,B,C) \-instance TupConcat L.Tup##A L.Tup##B L.Tup##C --#define TUPCONCAT_S(A,B,C) \-instance TupConcat S.Tup##A S.Tup##B S.Tup##C ------------------------------------------------------------------------------------TUPCONCAT_L(0,0,0)-TUPCONCAT_L(0,1,1)-TUPCONCAT_L(0,2,2)-TUPCONCAT_L(0,3,3)-TUPCONCAT_L(0,4,4)-TUPCONCAT_L(0,5,5)-TUPCONCAT_L(0,6,6)-TUPCONCAT_L(0,7,7)-TUPCONCAT_L(0,8,8)-TUPCONCAT_L(0,9,9)--TUPCONCAT_L(1,0,1)-TUPCONCAT_L(1,1,2)-TUPCONCAT_L(1,2,3)-TUPCONCAT_L(1,3,4)-TUPCONCAT_L(1,4,5)-TUPCONCAT_L(1,5,6)-TUPCONCAT_L(1,6,7)-TUPCONCAT_L(1,7,8)-TUPCONCAT_L(1,8,9)--TUPCONCAT_L(2,0,2)-TUPCONCAT_L(2,1,3)-TUPCONCAT_L(2,2,4)-TUPCONCAT_L(2,3,5)-TUPCONCAT_L(2,4,6)-TUPCONCAT_L(2,5,7)-TUPCONCAT_L(2,6,8)-TUPCONCAT_L(2,7,9)--TUPCONCAT_L(3,0,3)-TUPCONCAT_L(3,1,4)-TUPCONCAT_L(3,2,5)-TUPCONCAT_L(3,3,6)-TUPCONCAT_L(3,4,7)-TUPCONCAT_L(3,5,8)-TUPCONCAT_L(3,6,9)--TUPCONCAT_L(4,0,4)-TUPCONCAT_L(4,1,5)-TUPCONCAT_L(4,2,6)-TUPCONCAT_L(4,3,7)-TUPCONCAT_L(4,4,8)-TUPCONCAT_L(4,5,9)--TUPCONCAT_L(5,0,5)-TUPCONCAT_L(5,1,6)-TUPCONCAT_L(5,2,7)-TUPCONCAT_L(5,3,8)-TUPCONCAT_L(5,4,9)--TUPCONCAT_L(6,0,6)-TUPCONCAT_L(6,1,7)-TUPCONCAT_L(6,2,8)-TUPCONCAT_L(6,3,9)--TUPCONCAT_L(7,0,7)-TUPCONCAT_L(7,1,8)-TUPCONCAT_L(7,2,9)--TUPCONCAT_L(8,0,8)-TUPCONCAT_L(8,1,9)--TUPCONCAT_L(9,0,9)------------------------------------------------------------------------------------TUPCONCAT_S(0,0,0)-TUPCONCAT_S(0,1,1)-TUPCONCAT_S(0,2,2)-TUPCONCAT_S(0,3,3)-TUPCONCAT_S(0,4,4)-TUPCONCAT_S(0,5,5)-TUPCONCAT_S(0,6,6)-TUPCONCAT_S(0,7,7)-TUPCONCAT_S(0,8,8)-TUPCONCAT_S(0,9,9)--TUPCONCAT_S(1,0,1)-TUPCONCAT_S(1,1,2)-TUPCONCAT_S(1,2,3)-TUPCONCAT_S(1,3,4)-TUPCONCAT_S(1,4,5)-TUPCONCAT_S(1,5,6)-TUPCONCAT_S(1,6,7)-TUPCONCAT_S(1,7,8)-TUPCONCAT_S(1,8,9)--TUPCONCAT_S(2,0,2)-TUPCONCAT_S(2,1,3)-TUPCONCAT_S(2,2,4)-TUPCONCAT_S(2,3,5)-TUPCONCAT_S(2,4,6)-TUPCONCAT_S(2,5,7)-TUPCONCAT_S(2,6,8)-TUPCONCAT_S(2,7,9)--TUPCONCAT_S(3,0,3)-TUPCONCAT_S(3,1,4)-TUPCONCAT_S(3,2,5)-TUPCONCAT_S(3,3,6)-TUPCONCAT_S(3,4,7)-TUPCONCAT_S(3,5,8)-TUPCONCAT_S(3,6,9)--TUPCONCAT_S(4,0,4)-TUPCONCAT_S(4,1,5)-TUPCONCAT_S(4,2,6)-TUPCONCAT_S(4,3,7)-TUPCONCAT_S(4,4,8)-TUPCONCAT_S(4,5,9)--TUPCONCAT_S(5,0,5)-TUPCONCAT_S(5,1,6)-TUPCONCAT_S(5,2,7)-TUPCONCAT_S(5,3,8)-TUPCONCAT_S(5,4,9)--TUPCONCAT_S(6,0,6)-TUPCONCAT_S(6,1,7)-TUPCONCAT_S(6,2,8)-TUPCONCAT_S(6,3,9)--TUPCONCAT_S(7,0,7)-TUPCONCAT_S(7,1,8)-TUPCONCAT_S(7,2,9)--TUPCONCAT_S(8,0,8)-TUPCONCAT_S(8,1,9)--TUPCONCAT_S(9,0,9)-----------------------------------------------------------------------------------

@@ -1,6 +1,7 @@ 
 {-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 
+-- | Lazy homogeneous tuples
 module Data.Tup.Tup.Lazy where
 
 #define A a

@@ -1,6 +1,7 @@ 
 {-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
 
+-- | Strict homogeneous tuples
 module Data.Tup.Tup.Strict where
 
 #define A !a

@@ -12,21 +12,21 @@ import Foreign.Storable
 import Foreign.Marshal
 
-import Data.Tup.Tup.Class
+import Data.Tup.Class
 
 --------------------------------------------------------------------------------
 -- * data type declarations
 
-data Tup0 a = Tup0                    deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup1 a = Tup1 A                  deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup2 a = Tup2 A A                deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup3 a = Tup3 A A A              deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup4 a = Tup4 A A A A            deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup5 a = Tup5 A A A A A          deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup6 a = Tup6 A A A A A A        deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup7 a = Tup7 A A A A A A A      deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup8 a = Tup8 A A A A A A A A    deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
-data Tup9 a = Tup9 A A A A A A A A A  deriving (Eq,Ord,Show,Read,Functor,Foldable,Traversable)
+data Tup0 a = Tup0                    deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup1 a = Tup1 A                  deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup2 a = Tup2 A A                deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup3 a = Tup3 A A A              deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup4 a = Tup4 A A A A            deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup5 a = Tup5 A A A A A          deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup6 a = Tup6 A A A A A A        deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup7 a = Tup7 A A A A A A A      deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup8 a = Tup8 A A A A A A A A    deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
+data Tup9 a = Tup9 A A A A A A A A A  deriving (Eq,Ord,Show,Read,Bounded,Functor,Foldable,Traversable)
 
 --------------------------------------------------------------------------------
 -- * \"tupping\"

@@ -4,11 +4,17 @@ -- This can be considered as a different implementation of "Data.Tup.Tup" 
 -- (one which also scales for vectors/tuples longer than 9 elements)
 --
+-- Example:
+-- 
+-- > vec3 1 2 3  :: Vec3 Int
+-- > {{ 1,2,3 }} :: Vec3 Int
+-- > Cons 1 (Cons 2 (Cons 3 Empty)) :: Cons (Cons (Cons Empty)) Int
+--
 
-{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts, 
-             MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, UndecidableInstances 
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts 
   #-}
 module Data.Tup.Vec where
+--              MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances
 
 --------------------------------------------------------------------------------
 
@@ -25,40 +31,37 @@ 
 import Text.Show
 
+import Data.Tup.Class
+
 --------------------------------------------------------------------------------
 -- * The @Vec@ type class
 
-class (Functor v, Applicative v, Foldable v, Traversable v) => Vec v where 
-  vecSize     :: v a -> Int
-  vecToList   :: v a -> [a]
-  vecFromList :: [a] -> v a
+instance Tup Empty where
 
-  vecUndef    :: v a -> a
-  vecUndef _ = undefined
+  tupSize _ = 0             -- important to be as lazy as possible here!
 
-  undefinedVec :: v a
+  tupToList   Empty  = []
+  tupFromList []     = Empty
+  tupFromList (x:xs) = error "tupFromList: list length does not match"
 
-instance Vec Empty where
-  --vecSize     Empty  = 0
-  vecSize _ = 0
+  constantTup _ = Empty
+  undefinedTup  = Empty
 
-  vecToList   Empty  = []
-  vecFromList []     = Empty
-  vecFromList (x:xs) = error "vecFromList: list length does not match"
-  undefinedVec = Empty
+instance Tup v => Tup (Cons v) where
 
-instance Vec v => Vec (Cons v) where
-  --vecSize (Cons _ p) = 1 + vecSize p
-  vecSize v = 1 + vecSize (consUndefTail v)
+  --tupSize (Cons _ p) = 1 + vecSize p
+  tupSize v = 1 + tupSize (consUndefTail v)    -- better to be lazier!
 
-  vecToList (Cons x p) = x : vecToList p
-  vecFromList xxs = this where
+  tupToList (Cons x p) = x : tupToList p
+  tupFromList xxs = this where
     this = case xxs of
-      (x:xs) -> Cons x (vecFromList xs)
+      (x:xs) -> Cons x (tupFromList xs)
       []     -> err
-    err = error "vecFromList: list length odes not match"
-  undefinedVec = Cons undefined undefinedVec
+    err = error "tupFromList: list length odes not match"
 
+  constantTup x = Cons x (constantTup x)  
+  undefinedTup  = Cons undefined undefinedTup
+
 --------------------------------------------------------------------------------
 -- * Type abbreviations for short vectors
 
@@ -76,90 +79,24 @@ --------------------------------------------------------------------------------
 -- * The constructor types
 
-data Empty  a = Empty        deriving (Eq,Ord,Functor,Foldable,Traversable)
-data Cons v a = Cons a (v a) deriving (Eq,Ord,Functor,Foldable,Traversable)
-
-consUndefTail :: Vec v => Cons v a -> v a
-consUndefTail _ = undefinedVec
-
---------------------------------------------------------------------------------
--- * Misc 
-
--- | Safe version of 'vecFromList'.
-maybeVecFromList :: Vec f => [a] -> Maybe (f a)
-maybeVecFromList xs = result where
-  result = if length xs == vecSize (undef result) 
-    then Just (vecFromList xs)
-    else Nothing    
-  undef :: Maybe a -> a
-  undef _ = undefined
-
--- | Transpose a Vec of Vecs.
-transposeVec :: (Vec f, Vec g) => f (g a) -> g (f a)
-transposeVec = vecFromList . (map vecFromList) . transpose . (map vecToList) . vecToList
-
---------------------------------------------------------------------------------
--- * Concatenation
-
--- | safe concatenation
-maybeVecConcat :: (Vec f, Vec g, Vec h) => f a -> g a -> Maybe (h a)
-maybeVecConcat x y = 
-  if vecSize x + vecSize y == vecSize z 
-    then Just z
-    else Nothing  
-  where
-    z = vecFromList (vecToList x ++ vecToList y)
-
--- | unsafe concatenation
-unsafeVecConcat :: (Vec f, Vec g, Vec h) => f a -> g a -> h a
-unsafeVecConcat x y = z
-  where
-    z = vecFromList (vecToList x ++ vecToList y)
-
--- | concatenation with type class
-class (Vec u, Vec v, Vec w) => VecConcat u v w | u v -> w where
-  vecConcat :: u a -> v a -> w a
-
-instance Vec v => VecConcat Empty v v where
-  vecConcat Empty v = v
-
--- This seems to need UndecidableInstances?
-instance (Vec u, Vec v, VecConcat u v w) => VecConcat (Cons u) v (Cons w) where
-  vecConcat (Cons x u) v = Cons x (vecConcat u v)
-
---------------------------------------------------------------------------------
--- * Zipping 
-
-zipVecWith :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
-zipVecWith f t1 t2 = f <$> t1 <*> t2
-
-zipVecWith3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
-zipVecWith3 f t1 t2 t3 = f <$> t1 <*> t2 <*> t3
-
-zipVecWith4 :: Applicative f => (a -> b -> c -> d -> e) -> f a -> f b -> f c -> f d -> f e
-zipVecWith4 f t1 t2 t3 t4 = f <$> t1 <*> t2 <*> t3 <*> t4
-
-zipVec :: Applicative f => f a -> f b -> f (a,b)
-zipVec t1 t2 = (,) <$> t1 <*> t2
-
-zipVec3 :: Applicative f => f a -> f b -> f c -> f (a,b,c)
-zipVec3 t1 t2 t3 = (,,) <$> t1 <*> t2 <*> t3
+data Empty  a = Empty        deriving (Eq,Ord,Bounded,Functor,Foldable,Traversable)
+data Cons v a = Cons a (v a) deriving (Eq,Ord,Bounded,Functor,Foldable,Traversable)
 
-zipVec4 :: Applicative f => f a -> f b -> f c -> f d -> f (a,b,c,d)
-zipVec4 t1 t2 t3 t4 = (,,,) <$> t1 <*> t2 <*> t3 <*> t4
+consUndefTail :: Tup v => Cons v a -> v a
+consUndefTail _ = undefinedTup
 
 --------------------------------------------------------------------------------
 
 instance Show a => Show (Empty a) where
   show Empty = "Vec0"
 
-instance (Show a, Vec v) => Show (Cons v a) where
+instance (Show a, Tup v) => Show (Cons v a) where
   showsPrec d vec 
     = showParen (d>app_prec) 
     $ showString "Vec" . shows k . stuff xs
     where 
-      k  = vecSize vec
-      xs = vecToList vec
+      k  = tupSize vec
+      xs = tupToList vec
       show1 x = showsPrec (app_prec+1) x
       app_prec = 10
       stuff [] = id
@@ -189,7 +126,7 @@   signum = fmap signum       
   fromInteger = pure . fromInteger 
 
-instance (Num a, Num (v a), Vec v) => Num (Cons v a) where
+instance (Num a, Num (v a), Tup v) => Num (Cons v a) where
   t1 + t2 = (+) <$> t1 <*> t2 
   t1 - t2 = (-) <$> t1 <*> t2 
   t1 * t2 = (*) <$> t1 <*> t2 
@@ -204,7 +141,7 @@   recip   = fmap recip              
   fromRational = pure . fromRational 
 
-instance (Fractional a, Fractional (v a), Vec v) => Fractional (Cons v a) where
+instance (Fractional a, Fractional (v a), Tup v) => Fractional (Cons v a) where
   t1 / t2 = (/) <$> t1 <*> t2     
   recip   = fmap recip              
   fromRational = pure . fromRational 
@@ -215,29 +152,30 @@   mempty = pure mempty                  
   mappend t1 t2 = mappend <$> t1 <*> t2 
 
-instance (Monoid a, Monoid (v a), Vec v) => Monoid (Cons v a) where
+instance (Monoid a, Monoid (v a), Tup v) => Monoid (Cons v a) where
   mempty = pure mempty                  
   mappend t1 t2 = mappend <$> t1 <*> t2 
 
 --------------------------------------------------------------------------------
 
 instance Storable a => Storable (Empty a) where
-  sizeOf    t = vecSize t * sizeOf (vecUndef t)         
-  alignment t = alignment (vecUndef t)                  
+  sizeOf    t = tupSize t * sizeOf (tupUndef t)         
+  alignment t = alignment (tupUndef t)                  
   peek ptr    = let { ptrUndef :: Ptr b -> b ; ptrUndef _ = undefined }              
-                  in  vecFromList <$> peekArray (vecSize $ ptrUndef ptr) (castPtr ptr)
-  poke ptr t  = pokeArray (castPtr ptr) (vecToList t) 
+                  in  tupFromList <$> peekArray (tupSize $ ptrUndef ptr) (castPtr ptr)
+  poke ptr t  = pokeArray (castPtr ptr) (tupToList t) 
 
-instance (Storable a, Storable (v a), Vec v) => Storable (Cons v a)  where
-  sizeOf    t = vecSize t * sizeOf (vecUndef t)         
-  alignment t = alignment (vecUndef t)                  
+instance (Storable a, Storable (v a), Tup v) => Storable (Cons v a)  where
+  sizeOf    t = tupSize t * sizeOf (tupUndef t)         
+  alignment t = alignment (tupUndef t)                  
   peek ptr    = let { ptrUndef :: Ptr b -> b ; ptrUndef _ = undefined }              
-                  in  vecFromList <$> peekArray (vecSize $ ptrUndef ptr) (castPtr ptr)
-  poke ptr t  = pokeArray (castPtr ptr) (vecToList t) 
+                  in  tupFromList <$> peekArray (tupSize $ ptrUndef ptr) (castPtr ptr)
+  poke ptr t  = pokeArray (castPtr ptr) (tupToList t) 
 
 --------------------------------------------------------------------------------
 
-{-
+{- derived by GHC
+
 instance Eq a => Eq (Empty a) where 
   (==) Empty Empty = True
 
@@ -249,6 +187,7 @@ 
 instance (Ord a, Vec v) => Ord (Cons v a) where 
   compare u v = compare (vecToList u) (vecToList v)
+
 -}
 
 --------------------------------------------------------------------------------
@@ -258,31 +197,31 @@ vec0 = Empty
 
 vec1 :: a -> Vec1 a
-vec1 x1 = vecFromList [x1]
+vec1 x1 = tupFromList [x1]
 
 vec2 :: a -> a -> Vec2 a
-vec2 x1 x2 = vecFromList [x1,x2]
+vec2 x1 x2 = tupFromList [x1,x2]
 
 vec3 :: a -> a -> a -> Vec3 a
-vec3 x1 x2 x3 = vecFromList [x1,x2,x3]
+vec3 x1 x2 x3 = tupFromList [x1,x2,x3]
 
 vec4 :: a -> a -> a -> a -> Vec4 a
-vec4 x1 x2 x3 x4 = vecFromList [x1,x2,x3,x4]
+vec4 x1 x2 x3 x4 = tupFromList [x1,x2,x3,x4]
 
 vec5 :: a -> a -> a -> a -> a -> Vec5 a
-vec5 x1 x2 x3 x4 x5 = vecFromList [x1,x2,x3,x4,x5]
+vec5 x1 x2 x3 x4 x5 = tupFromList [x1,x2,x3,x4,x5]
 
 vec6 :: a -> a -> a -> a -> a -> a -> Vec6 a
-vec6 x1 x2 x3 x4 x5 x6 = vecFromList [x1,x2,x3,x4,x5,x6]
+vec6 x1 x2 x3 x4 x5 x6 = tupFromList [x1,x2,x3,x4,x5,x6]
 
 vec7 :: a -> a -> a -> a -> a -> a -> a -> Vec7 a
-vec7 x1 x2 x3 x4 x5 x6 x7 = vecFromList [x1,x2,x3,x4,x5,x6,x7]
+vec7 x1 x2 x3 x4 x5 x6 x7 = tupFromList [x1,x2,x3,x4,x5,x6,x7]
 
 vec8 :: a -> a -> a -> a -> a -> a -> a -> a -> Vec8 a
-vec8 x1 x2 x3 x4 x5 x6 x7 x8 = vecFromList [x1,x2,x3,x4,x5,x6,x7,x8]
+vec8 x1 x2 x3 x4 x5 x6 x7 x8 = tupFromList [x1,x2,x3,x4,x5,x6,x7,x8]
 
 vec9 :: a -> a -> a -> a -> a -> a -> a -> a -> a -> Vec9 a
-vec9 x1 x2 x3 x4 x5 x6 x7 x8 x9 = vecFromList [x1,x2,x3,x4,x5,x6,x7,x8,x9]
+vec9 x1 x2 x3 x4 x5 x6 x7 x8 x9 = tupFromList [x1,x2,x3,x4,x5,x6,x7,x8,x9]
 
 --------------------------------------------------------------------------------
 -- * \"veccing\"

@@ -13,6 +13,7 @@ -- -- > x = (Tup3 a b c) -- > x = (Cons a (Cons b (Cons c Empty)))+-- > x = (NTup3 (a,b,c)) --  -- This should also work in pattern context. --@@ -34,7 +35,9 @@ -- debug x = trace (show x)  --------------------------------------------------------------------------------+-- vec +-- | A string constructor (used for Cons and Empty) constructor :: String -> Exp constructor con = Var $ UnQual $ Ident (con) @@ -42,31 +45,49 @@ toVecListE e =    case e of     Con (Special UnitCon) -> go []-    Tuple es -> go es -    _        -> go [e]+    Tuple boxed es -> go es +    _              -> go [e]   where     go [] = constructor "Empty"     go (x:xs) = App (App (constructor "Cons") x) (go xs)  --------------------------------------------------------------------------------+-- tup +-- | The constructor Tup<K> tupleCon :: Int -> Exp tupleCon k = Var $ UnQual $ Ident ("Tup" ++ show k)  toTupleE :: Exp -> Exp toTupleE e = case e of   Con (Special UnitCon) -> tupleCon 0-  Tuple es -> foldl App (tupleCon (length es)) es-  _        -> App (tupleCon 1) e+  Tuple boxed es -> foldl App (tupleCon (length es)) es+  _              -> App (tupleCon 1) e +--------------------------------------------------------------------------------+-- ntup++-- | The constructor NTup<K>+ntupCon :: Int -> Exp+ntupCon k = Var $ UnQual $ Ident ("NTup" ++ show k)++toNewtypeE :: Exp -> Exp+toNewtypeE e = case e of+  Con (Special UnitCon) -> ntupCon 0+  Tuple boxed es -> App (ntupCon (length es)) e+  _              -> App (ntupCon 1) e++--------------------------------------------------------------------------------+ inparens :: String -> String inparens s = "(" ++ s ++ ")"  toTupleS :: Cfg -> String -> String toTupleS cfg s = {- trace ("|"++s++"|") $ -} case parseExp (inparens s) of   ParseOk e -> case cfg of-    TupPP -> pp (toTupleE   e)-    VecPP -> pp (toVecListE e)+    TupPP  -> pp (toTupleE   e)+    VecPP  -> pp (toVecListE e)+    NTupPP -> pp (toNewtypeE e)   err -> error ("tuplepp: parse error in tuple bracket:\n" ++ show err)  pp :: Pretty a => a -> String@@ -143,16 +164,18 @@      --------------------------------------------------------------------------------   -data Cfg = TupPP | VecPP deriving (Eq,Show)+data Cfg = TupPP | VecPP | NTupPP deriving (Eq,Show) -tupCfg, vecCfg :: Cfg-tupCfg = TupPP-vecCfg = VecPP+tupCfg, vecCfg, ntupCfg :: Cfg+tupCfg  = TupPP+vecCfg  = VecPP+ntupCfg = NTupPP -tupOpts, vecOpts, possibleOpts :: [String]-tupOpts = [ "-t" , "--tup" ] -vecOpts = [ "-v" , "--vec" ]-possibleOpts = vecOpts ++ tupOpts+tupOpts, vecOpts, newtypeOpts, possibleOpts :: [String]+tupOpts      = [ "-t" , "--tup" ] +vecOpts      = [ "-v" , "--vec" ]+newtypeOpts  = [ "-n" , "--ntup" , "--newtype" ]+possibleOpts = vecOpts ++ tupOpts ++ newtypeOpts  main :: IO () main = @@ -161,10 +184,11 @@     let opts = filter (\x ->      x `elem` possibleOpts ) args0         args = filter (\x -> not (x `elem` possibleOpts)) args0     let vecMode = not (null opts)-    let cfg | null opts                            = tupCfg    -- default is tup-            | not (null (intersect opts tupOpts))  = tupCfg-            | not (null (intersect opts vecOpts))  = vecCfg-            | True                                 = error "tuplepp: fatal error while parsing the options"+    let cfg | null opts                                = tupCfg    -- default is tup+            | not (null (intersect opts tupOpts    ))  = tupCfg+            | not (null (intersect opts vecOpts    ))  = vecCfg+            | not (null (intersect opts newtypeOpts))  = ntupCfg+            | True                                     = error "tuplepp: fatal error while parsing the options"      case args of @@ -191,6 +215,7 @@           , "options:"           , "  -t, --tup : generates (Tup3 105 106 107) expressions/patterns"           , "  -v, --vec : generates (Cons 105 (Cons 106 (Cons 107 Empty))) expressions/patterns"+          , "  -n, --ntup, --newtype : generates (NTup3 (105,106,107)) expressions/patterns"           ]          where

@@ -1,21 +1,21 @@  Name:                tup-functor-Version:             0.2.0.3+Version:             0.3.0.0 Synopsis:            Homogeneous tuples Description:         Homogeneous tuples (also known as vectors), with various instances, most notably 'Functor' and 'Applicative'.                      The primary goal of the library is to help functor-oriented programming                        (for low-dimensional linear algebra, there are more specific packages, eg. @vect@). -                     A small preprocessor for a tuple syntax is also included. We also provide a different implementation -                     using type-level programming.+                     A small preprocessor for a tuple syntax is also included. We provide 4 different implementations,+                     with a unified type class interface. Author:              Balazs Komuves license:             BSD3 license-file:        LICENSE-Copyright:           (c) 2012 Balazs Komuves+Copyright:           (c) 2012-2014 Balazs Komuves Maintainer:          bkomuves (plus) hackage (at) gmail (dot) hu Homepage:            http://code.haskell.org/~bkomuves/ Stability:           Experimental Category:            Data-Tested-With:         GHC == 7.0.3+Tested-With:         GHC == 7.8.3 Cabal-Version:       >= 1.6 Build-Type:          Simple @@ -29,12 +29,13 @@   Build-Depends:       base >= 3 && < 5, cpphs >= 1.3    Exposed-Modules:     Data.Tup+                       Data.Tup.Class+                       Data.Tup.Concat                        Data.Tup.Vec+                       Data.Tup.Newtype                        Data.Tup.Tup-                       Data.Tup.Tup.Class                        Data.Tup.Tup.Strict                        Data.Tup.Tup.Lazy-                       Data.Tup.Tup.Concat    Extensions:          CPP   Hs-Source-Dirs:      .