packages feed

tup-functor 0.1 → 0.2

raw patch · 14 files changed

+821/−356 lines, 14 filesdep +cpphs

Dependencies added: cpphs

Files

Data/Tup.hs view
@@ -8,16 +8,16 @@ -- >   tupFromList :: [a] -> f a 
 -- >   tupUndef    :: f a -> a
 --
--- Also included is a very simple preprocesszor @tpp@ which translates
+-- Also included is a very simple preprocesszor @tuplepp@ which translates
 -- the syntax @\{\{a,b,c\}\}@ into @(Tup3 a b c)@.
+--
+-- 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.
+--
 
-module Data.Tup 
-  ( module Data.Tup.Class
-  , module Data.Tup.Lazy 
-  ) 
-  where
+module Data.Tup ( module Data.Tup.Tup )  where
 
 import Control.Applicative ( Applicative )     -- only for Haddock
 
-import Data.Tup.Class
-import Data.Tup.Lazy+import Data.Tup.Tup
− Data/Tup/Class.hs 
@@ -1,58 +0,0 @@-
-module Data.Tup.Class where
-
---------------------------------------------------------------------------------
-
-import Control.Applicative
-import Data.List
-
---------------------------------------------------------------------------------
--- * the Tup class
-
-class (Functor f, Applicative 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
-
---------------------------------------------------------------------------------
--- * 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
-
---------------------------------------------------------------------------------
-
− Data/Tup/Lazy.hs 
@@ -1,9 +0,0 @@-
-{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
-
-module Data.Tup.Lazy where
-
-#define A a
-
-#include "Tup.inc"
-
− Data/Tup/Strict.hs 
@@ -1,9 +0,0 @@-
-{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
-
-module Data.Tup.Strict where
-
-#define A !a
-
-#include "Tup.inc"
-
+ Data/Tup/Tup.hs view
@@ -0,0 +1,26 @@+
+-- | This small library defines data types 'Tup1', 'Tup2' ... 'Tup9' for homogeneous tuples of small size (both strict and lazy), 
+-- and various instances for them, most notably 'Functor' and 'Applicative'. We also have a 'Tup' type class:
+-- 
+-- > class Tup f where
+-- >   tupSize     :: f a -> Int
+-- >   tupToList   :: f a -> [a]
+-- >   tupFromList :: [a] -> f a 
+-- >   tupUndef    :: f a -> 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.Tup.Lazy 
+  , module Data.Tup.Tup.Concat
+  ) 
+  where
+
+import Control.Applicative ( Applicative )     -- only for Haddock
+
+import Data.Tup.Tup.Class
+import Data.Tup.Tup.Lazy
+import Data.Tup.Tup.Concat
− Data/Tup/Tup.inc 
@@ -1,233 +0,0 @@-
---------------------------------------------------------------------------------
-
-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
-
---------------------------------------------------------------------------------
--- * data type declarations
-
-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)
-
---------------------------------------------------------------------------------
--- * \"tupping\"
-
-tupTup :: Applicative f => f a -> f a -> f (Tup2 a)
-tupTup t1 t2 = Tup2 <$> t1 <*> t2
-
-tupTup3 :: Applicative f => f a -> f a -> f a -> f (Tup3 a)
-tupTup3 t1 t2 t3 = Tup3 <$> t1 <*> t2 <*> t3
-
-tupTup4 :: Applicative f => f a -> f a -> f a -> f a -> f (Tup4 a)
-tupTup4 t1 t2 t3 t4 = Tup4 <$> t1 <*> t2 <*> t3 <*> t4
-
-tupTup5 :: Applicative f => f a -> f a -> f a -> f a -> f a -> f (Tup5 a)
-tupTup5 t1 t2 t3 t4 t5 = Tup5 <$> t1 <*> t2 <*> t3 <*> t4 <*> t5
-
---------------------------------------------------------------------------------
--- * instances
-
-instance Tup Tup1 where
-  tupSize _ = 1
-  tupToList (Tup1 x1) = [x1]
-  tupFromList [x1] = Tup1 x1
-  tupFromList _ = error "tupFromList: list should have length 1"
-
-instance Tup Tup2 where
-  tupSize _ = 2
-  tupToList (Tup2 x1 x2) = [x1,x2]
-  tupFromList [x1,x2] = Tup2 x1 x2
-  tupFromList _ = error "tupFromList: list should have length 2"
-
-instance Tup Tup3 where
-  tupSize _ = 3
-  tupToList (Tup3 x1 x2 x3) = [x1,x2,x3]
-  tupFromList [x1,x2,x3] = Tup3 x1 x2 x3
-  tupFromList _ = error "tupFromList: list should have length 3"
-
-instance Tup Tup4 where
-  tupSize _ = 4
-  tupToList (Tup4 x1 x2 x3 x4) = [x1,x2,x3,x4]
-  tupFromList [x1,x2,x3,x4] = Tup4 x1 x2 x3 x4
-  tupFromList _ = error "tupFromList: list should have length 4"
-
-instance Tup Tup5 where
-  tupSize _ = 5
-  tupToList (Tup5 x1 x2 x3 x4 x5) = [x1,x2,x3,x4,x5]
-  tupFromList [x1,x2,x3,x4,x5] = Tup5 x1 x2 x3 x4 x5
-  tupFromList _ = error "tupFromList: list should have length 5"
-
-instance Tup Tup6 where
-  tupSize _ = 6
-  tupToList (Tup6 x1 x2 x3 x4 x5 x6) = [x1,x2,x3,x4,x5,x6]
-  tupFromList [x1,x2,x3,x4,x5,x6] = Tup6 x1 x2 x3 x4 x5 x6
-  tupFromList _ = error "tupFromList: list should have length 6"
-
-instance Tup Tup7 where
-  tupSize _ = 7
-  tupToList (Tup7 x1 x2 x3 x4 x5 x6 x7) = [x1,x2,x3,x4,x5,x6,x7]
-  tupFromList [x1,x2,x3,x4,x5,x6,x7] = Tup7 x1 x2 x3 x4 x5 x6 x7
-  tupFromList _ = error "tupFromList: list should have length 7"
-
-instance Tup Tup8 where
-  tupSize _ = 8
-  tupToList (Tup8 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] = Tup8 x1 x2 x3 x4 x5 x6 x7 x8
-  tupFromList _ = error "tupFromList: list should have length 8"
-
-instance Tup Tup9 where
-  tupSize _ = 9
-  tupToList (Tup9 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] = Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9
-  tupFromList _ = error "tupFromList: list should have length 9"
-
---------------------------------------------------------------------------------
-
-instance Applicative Tup1 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup1 x
-  Tup1 f1 <*> Tup1 x1 = Tup1 (f1 x1)
-
-instance Applicative Tup2 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup2 x x
-  Tup2 f1 f2 <*> Tup2 x1 x2 = Tup2 (f1 x1) (f2 x2)
-
-instance Applicative Tup3 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup3 x x x
-  Tup3 f1 f2 f3 <*> Tup3 x1 x2 x3 = Tup3 (f1 x1) (f2 x2) (f3 x3)
-
-instance Applicative Tup4 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup4 x x x x
-  Tup4 f1 f2 f3 f4 <*> Tup4 x1 x2 x3 x4 = Tup4 (f1 x1) (f2 x2) (f3 x3) (f4 x4)
-
-instance Applicative Tup5 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup5 x x x x x
-  Tup5 f1 f2 f3 f4 f5 <*> Tup5 x1 x2 x3 x4 x5 = Tup5 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5)
-
-instance Applicative Tup6 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup6 x x x x x x
-  Tup6 f1 f2 f3 f4 f5 f6 <*> Tup6 x1 x2 x3 x4 x5 x6 = Tup6 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6)
-
-instance Applicative Tup7 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup7 x x x x x x x
-  Tup7 f1 f2 f3 f4 f5 f6 f7 <*> Tup7 x1 x2 x3 x4 x5 x6 x7 
-    = Tup7 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7)
-
-instance Applicative Tup8 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup8 x x x x x x x x
-  Tup8 f1 f2 f3 f4 f5 f6 f7 f8 <*> Tup8 x1 x2 x3 x4 x5 x6 x7 x8 
-    = Tup8 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7) (f8 x8)
-
-instance Applicative Tup9 where
-  {-# INLINE pure  #-}
-  {-# INLINE (<*>) #-}
-  pure x = Tup9 x x x x x x x x x
-  Tup9 f1 f2 f3 f4 f5 f6 f7 f8 f9 <*> Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9 
-    = Tup9 (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 (Tup1 a) where NUM_INSTANCE
-instance Num a => Num (Tup2 a) where NUM_INSTANCE
-instance Num a => Num (Tup3 a) where NUM_INSTANCE
-instance Num a => Num (Tup4 a) where NUM_INSTANCE
-instance Num a => Num (Tup5 a) where NUM_INSTANCE
-instance Num a => Num (Tup6 a) where NUM_INSTANCE
-instance Num a => Num (Tup7 a) where NUM_INSTANCE
-instance Num a => Num (Tup8 a) where NUM_INSTANCE
-instance Num a => Num (Tup9 a) where NUM_INSTANCE
-
---------------------------------------------------------------------------------
-
-#define FRACTIONAL_INSTANCE              \
-  { t1 / t2 = (/) <$> t1 <*> t2          \
-  ; recip   = fmap recip                 \
-  ; fromRational = pure . fromRational }
-
-instance Fractional a => Fractional (Tup1 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup2 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup3 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup4 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup5 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup6 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup7 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup8 a) where FRACTIONAL_INSTANCE
-instance Fractional a => Fractional (Tup9 a) where FRACTIONAL_INSTANCE
-
---------------------------------------------------------------------------------
-
-#define MONOID_INSTANCE                     \
-  { mempty = pure mempty                    \
-  ; mappend t1 t2 = mappend <$> t1 <*> t2 } 
-
-instance Monoid a => Monoid (Tup1 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup2 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup3 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup4 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup5 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup6 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup7 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup8 a) where MONOID_INSTANCE
-instance Monoid a => Monoid (Tup9 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 (Tup1 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup2 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup3 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup4 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup5 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup6 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup7 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup8 a) where STORABLE_INSTANCE
-instance Storable a => Storable (Tup9 a) where STORABLE_INSTANCE
-
---------------------------------------------------------------------------------
+ Data/Tup/Tup/Class.hs view
@@ -0,0 +1,77 @@+
+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
+
+--------------------------------------------------------------------------------
+
+ Data/Tup/Tup/Concat.hs view
@@ -0,0 +1,95 @@+
+-- | Concatenation of tuples. Requires MPTCs and FunDeps. 
+
+{-# OPTIONS_GHC -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(A,B,C) \
+instance TupConcat L.Tup##A L.Tup##B L.Tup##C ; \
+instance TupConcat S.Tup##A S.Tup##B S.Tup##C
+
+--------------------------------------------------------------------------------
+
+TUPCONCAT(0,0,0)
+TUPCONCAT(0,1,1)
+TUPCONCAT(0,2,2)
+TUPCONCAT(0,3,3)
+TUPCONCAT(0,4,4)
+TUPCONCAT(0,5,5)
+TUPCONCAT(0,6,6)
+TUPCONCAT(0,7,7)
+TUPCONCAT(0,8,8)
+TUPCONCAT(0,9,9)
+
+TUPCONCAT(1,0,1)
+TUPCONCAT(1,1,2)
+TUPCONCAT(1,2,3)
+TUPCONCAT(1,3,4)
+TUPCONCAT(1,4,5)
+TUPCONCAT(1,5,6)
+TUPCONCAT(1,6,7)
+TUPCONCAT(1,7,8)
+TUPCONCAT(1,8,9)
+
+TUPCONCAT(2,0,2)
+TUPCONCAT(2,1,3)
+TUPCONCAT(2,2,4)
+TUPCONCAT(2,3,5)
+TUPCONCAT(2,4,6)
+TUPCONCAT(2,5,7)
+TUPCONCAT(2,6,8)
+TUPCONCAT(2,7,9)
+
+TUPCONCAT(3,0,3)
+TUPCONCAT(3,1,4)
+TUPCONCAT(3,2,5)
+TUPCONCAT(3,3,6)
+TUPCONCAT(3,4,7)
+TUPCONCAT(3,5,8)
+TUPCONCAT(3,6,9)
+
+TUPCONCAT(4,0,4)
+TUPCONCAT(4,1,5)
+TUPCONCAT(4,2,6)
+TUPCONCAT(4,3,7)
+TUPCONCAT(4,4,8)
+TUPCONCAT(4,5,9)
+
+TUPCONCAT(5,0,5)
+TUPCONCAT(5,1,6)
+TUPCONCAT(5,2,7)
+TUPCONCAT(5,3,8)
+TUPCONCAT(5,4,9)
+
+TUPCONCAT(6,0,6)
+TUPCONCAT(6,1,7)
+TUPCONCAT(6,2,8)
+TUPCONCAT(6,3,9)
+
+TUPCONCAT(7,0,7)
+TUPCONCAT(7,1,8)
+TUPCONCAT(7,2,9)
+
+TUPCONCAT(8,0,8)
+TUPCONCAT(8,1,9)
+
+TUPCONCAT(9,0,9)
+
+--------------------------------------------------------------------------------
+
+ Data/Tup/Tup/Lazy.hs view
@@ -0,0 +1,9 @@+
+{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+
+module Data.Tup.Tup.Lazy where
+
+#define A a
+
+#include "Tup.inc"
+
+ Data/Tup/Tup/Strict.hs view
@@ -0,0 +1,9 @@+
+{-# LANGUAGE CPP, DeriveFunctor, DeriveFoldable, DeriveTraversable #-}
+
+module Data.Tup.Tup.Strict where
+
+#define A !a
+
+#include "Tup.inc"
+
+ Data/Tup/Tup/Tup.inc view
@@ -0,0 +1,250 @@+
+--------------------------------------------------------------------------------
+
+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.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)
+
+--------------------------------------------------------------------------------
+-- * \"tupping\"
+
+tupTup :: Applicative f => f a -> f a -> f (Tup2 a)
+tupTup t1 t2 = Tup2 <$> t1 <*> t2
+
+tupTup3 :: Applicative f => f a -> f a -> f a -> f (Tup3 a)
+tupTup3 t1 t2 t3 = Tup3 <$> t1 <*> t2 <*> t3
+
+tupTup4 :: Applicative f => f a -> f a -> f a -> f a -> f (Tup4 a)
+tupTup4 t1 t2 t3 t4 = Tup4 <$> t1 <*> t2 <*> t3 <*> t4
+
+tupTup5 :: Applicative f => f a -> f a -> f a -> f a -> f a -> f (Tup5 a)
+tupTup5 t1 t2 t3 t4 t5 = Tup5 <$> t1 <*> t2 <*> t3 <*> t4 <*> t5
+
+--------------------------------------------------------------------------------
+-- * instances
+
+instance Tup Tup0 where
+  tupSize _ = 0
+  tupToList (Tup0) = []
+  tupFromList [] = Tup0
+  tupFromList _ = error "tupFromList: list should have length 0"
+
+instance Tup Tup1 where
+  tupSize _ = 1
+  tupToList (Tup1 x1) = [x1]
+  tupFromList [x1] = Tup1 x1
+  tupFromList _ = error "tupFromList: list should have length 1"
+
+instance Tup Tup2 where
+  tupSize _ = 2
+  tupToList (Tup2 x1 x2) = [x1,x2]
+  tupFromList [x1,x2] = Tup2 x1 x2
+  tupFromList _ = error "tupFromList: list should have length 2"
+
+instance Tup Tup3 where
+  tupSize _ = 3
+  tupToList (Tup3 x1 x2 x3) = [x1,x2,x3]
+  tupFromList [x1,x2,x3] = Tup3 x1 x2 x3
+  tupFromList _ = error "tupFromList: list should have length 3"
+
+instance Tup Tup4 where
+  tupSize _ = 4
+  tupToList (Tup4 x1 x2 x3 x4) = [x1,x2,x3,x4]
+  tupFromList [x1,x2,x3,x4] = Tup4 x1 x2 x3 x4
+  tupFromList _ = error "tupFromList: list should have length 4"
+
+instance Tup Tup5 where
+  tupSize _ = 5
+  tupToList (Tup5 x1 x2 x3 x4 x5) = [x1,x2,x3,x4,x5]
+  tupFromList [x1,x2,x3,x4,x5] = Tup5 x1 x2 x3 x4 x5
+  tupFromList _ = error "tupFromList: list should have length 5"
+
+instance Tup Tup6 where
+  tupSize _ = 6
+  tupToList (Tup6 x1 x2 x3 x4 x5 x6) = [x1,x2,x3,x4,x5,x6]
+  tupFromList [x1,x2,x3,x4,x5,x6] = Tup6 x1 x2 x3 x4 x5 x6
+  tupFromList _ = error "tupFromList: list should have length 6"
+
+instance Tup Tup7 where
+  tupSize _ = 7
+  tupToList (Tup7 x1 x2 x3 x4 x5 x6 x7) = [x1,x2,x3,x4,x5,x6,x7]
+  tupFromList [x1,x2,x3,x4,x5,x6,x7] = Tup7 x1 x2 x3 x4 x5 x6 x7
+  tupFromList _ = error "tupFromList: list should have length 7"
+
+instance Tup Tup8 where
+  tupSize _ = 8
+  tupToList (Tup8 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] = Tup8 x1 x2 x3 x4 x5 x6 x7 x8
+  tupFromList _ = error "tupFromList: list should have length 8"
+
+instance Tup Tup9 where
+  tupSize _ = 9
+  tupToList (Tup9 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] = Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9
+  tupFromList _ = error "tupFromList: list should have length 9"
+
+--------------------------------------------------------------------------------
+
+instance Applicative Tup0 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup0
+  Tup0 <*> Tup0 = Tup0 
+
+instance Applicative Tup1 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup1 x
+  Tup1 f1 <*> Tup1 x1 = Tup1 (f1 x1)
+
+instance Applicative Tup2 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup2 x x
+  Tup2 f1 f2 <*> Tup2 x1 x2 = Tup2 (f1 x1) (f2 x2)
+
+instance Applicative Tup3 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup3 x x x
+  Tup3 f1 f2 f3 <*> Tup3 x1 x2 x3 = Tup3 (f1 x1) (f2 x2) (f3 x3)
+
+instance Applicative Tup4 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup4 x x x x
+  Tup4 f1 f2 f3 f4 <*> Tup4 x1 x2 x3 x4 = Tup4 (f1 x1) (f2 x2) (f3 x3) (f4 x4)
+
+instance Applicative Tup5 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup5 x x x x x
+  Tup5 f1 f2 f3 f4 f5 <*> Tup5 x1 x2 x3 x4 x5 = Tup5 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5)
+
+instance Applicative Tup6 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup6 x x x x x x
+  Tup6 f1 f2 f3 f4 f5 f6 <*> Tup6 x1 x2 x3 x4 x5 x6 = Tup6 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6)
+
+instance Applicative Tup7 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup7 x x x x x x x
+  Tup7 f1 f2 f3 f4 f5 f6 f7 <*> Tup7 x1 x2 x3 x4 x5 x6 x7 
+    = Tup7 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7)
+
+instance Applicative Tup8 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup8 x x x x x x x x
+  Tup8 f1 f2 f3 f4 f5 f6 f7 f8 <*> Tup8 x1 x2 x3 x4 x5 x6 x7 x8 
+    = Tup8 (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7) (f8 x8)
+
+instance Applicative Tup9 where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Tup9 x x x x x x x x x
+  Tup9 f1 f2 f3 f4 f5 f6 f7 f8 f9 <*> Tup9 x1 x2 x3 x4 x5 x6 x7 x8 x9 
+    = Tup9 (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 (Tup0 a) where NUM_INSTANCE
+instance Num a => Num (Tup1 a) where NUM_INSTANCE
+instance Num a => Num (Tup2 a) where NUM_INSTANCE
+instance Num a => Num (Tup3 a) where NUM_INSTANCE
+instance Num a => Num (Tup4 a) where NUM_INSTANCE
+instance Num a => Num (Tup5 a) where NUM_INSTANCE
+instance Num a => Num (Tup6 a) where NUM_INSTANCE
+instance Num a => Num (Tup7 a) where NUM_INSTANCE
+instance Num a => Num (Tup8 a) where NUM_INSTANCE
+instance Num a => Num (Tup9 a) where NUM_INSTANCE
+
+--------------------------------------------------------------------------------
+
+#define FRACTIONAL_INSTANCE              \
+  { t1 / t2 = (/) <$> t1 <*> t2          \
+  ; recip   = fmap recip                 \
+  ; fromRational = pure . fromRational }
+
+instance Fractional a => Fractional (Tup0 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup1 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup2 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup3 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup4 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup5 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup6 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup7 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup8 a) where FRACTIONAL_INSTANCE
+instance Fractional a => Fractional (Tup9 a) where FRACTIONAL_INSTANCE
+
+--------------------------------------------------------------------------------
+
+#define MONOID_INSTANCE                     \
+  { mempty = pure mempty                    \
+  ; mappend t1 t2 = mappend <$> t1 <*> t2 } 
+
+instance Monoid a => Monoid (Tup0 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup1 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup2 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup3 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup4 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup5 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup6 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup7 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup8 a) where MONOID_INSTANCE
+instance Monoid a => Monoid (Tup9 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 (Tup0 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup1 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup2 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup3 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup4 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup5 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup6 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup7 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup8 a) where STORABLE_INSTANCE
+instance Storable a => Storable (Tup9 a) where STORABLE_INSTANCE
+
+--------------------------------------------------------------------------------
+ Data/Tup/Vec.hs view
@@ -0,0 +1,276 @@+
+-- | Homogeneous lists with the length encoded in the type.
+--
+-- This can be considered as a different implementation of "Data.Tup.Tup" 
+-- (one which also scales for vectors/tuples longer than 9 elements)
+--
+
+{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable, FlexibleContexts #-}
+module Data.Tup.Vec 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 Text.Show
+
+--------------------------------------------------------------------------------
+-- * 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
+
+  vecUndef    :: v a -> a
+  vecUndef _ = undefined
+
+instance Vec Empty where
+  vecSize     Empty  = 0
+  vecToList   Empty  = []
+  vecFromList []     = Empty
+  vecFromList (x:xs) = error "vecFromList: list length does not match"
+
+instance Vec v => Vec (Cons v) where
+  vecSize (Cons _ p) = 1 + vecSize p
+  vecToList (Cons x p) = x : vecToList p
+  vecFromList xxs = this where
+    this = case xxs of
+      (x:xs) -> Cons x (vecFromList xs)
+      []     -> err
+    err = error "vecFromList: list length odes not match"
+
+--------------------------------------------------------------------------------
+-- * Type abbreviations for short vectors
+
+type Vec0 = Empty
+type Vec1 = Cons Vec0
+type Vec2 = Cons Vec1
+type Vec3 = Cons Vec2
+type Vec4 = Cons Vec3
+type Vec5 = Cons Vec4
+type Vec6 = Cons Vec5
+type Vec7 = Cons Vec6
+type Vec8 = Cons Vec7
+type Vec9 = Cons Vec8
+
+--------------------------------------------------------------------------------
+-- * 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)
+
+--------------------------------------------------------------------------------
+-- * 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
+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)
+
+unsafeVecConcat :: (Vec f, Vec g, Vec h) => f a -> g a -> h a
+unsafeVecConcat x y = z
+  where
+    z = vecFromList (vecToList x ++ vecToList y)
+
+--------------------------------------------------------------------------------
+-- * 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
+
+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
+
+--------------------------------------------------------------------------------
+
+instance Show a => Show (Empty a) where
+  show Empty = "Vec0"
+
+instance (Show a, Vec 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
+      show1 x = showsPrec (app_prec+1) x
+      app_prec = 10
+      stuff [] = id
+      stuff (y:ys) = showChar ' ' . show1 y . stuff ys
+
+--------------------------------------------------------------------------------
+
+instance Applicative Empty where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Empty
+  Empty <*> Empty = Empty
+
+instance Applicative v => Applicative (Cons v) where
+  {-# INLINE pure  #-}
+  {-# INLINE (<*>) #-}
+  pure x = Cons x (pure x)
+  Cons f fs <*> Cons x xs = Cons (f x) (fs <*> xs)
+  
+--------------------------------------------------------------------------------
+
+instance Num a => Num (Empty a) where
+  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 (v a), Vec v) => Num (Cons v a) where
+  t1 + t2 = (+) <$> t1 <*> t2 
+  t1 - t2 = (-) <$> t1 <*> t2 
+  t1 * t2 = (*) <$> t1 <*> t2 
+  abs    = fmap abs           
+  signum = fmap signum       
+  fromInteger = pure . fromInteger 
+
+--------------------------------------------------------------------------------
+
+instance Fractional a => Fractional (Empty a) where
+  t1 / t2 = (/) <$> t1 <*> t2     
+  recip   = fmap recip              
+  fromRational = pure . fromRational 
+
+instance (Fractional a, Fractional (v a), Vec v) => Fractional (Cons v a) where
+  t1 / t2 = (/) <$> t1 <*> t2     
+  recip   = fmap recip              
+  fromRational = pure . fromRational 
+
+--------------------------------------------------------------------------------
+
+instance Monoid a => Monoid (Empty a) where
+  mempty = pure mempty                  
+  mappend t1 t2 = mappend <$> t1 <*> t2 
+
+instance (Monoid a, Monoid (v a), Vec 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)                  
+  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) 
+
+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)                  
+  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) 
+
+--------------------------------------------------------------------------------
+
+{-
+instance Eq a => Eq (Empty a) where 
+  (==) Empty Empty = True
+
+instance (Eq a, Vec v) => Eq (Cons v a) where 
+  (==) u v = (vecToList u == vecToList v)
+
+instance Ord a => Ord (Empty a) where 
+  compare Empty Empty = EQ
+
+instance (Ord a, Vec v) => Ord (Cons v a) where 
+  compare u v = compare (vecToList u) (vecToList v)
+-}
+
+--------------------------------------------------------------------------------
+-- * Short constructor functions
+
+vec0 :: Vec0 a
+vec0 = Empty
+
+vec1 :: a -> Vec1 a
+vec1 x1 = vecFromList [x1]
+
+vec2 :: a -> a -> Vec2 a
+vec2 x1 x2 = vecFromList [x1,x2]
+
+vec3 :: a -> a -> a -> Vec3 a
+vec3 x1 x2 x3 = vecFromList [x1,x2,x3]
+
+vec4 :: a -> a -> a -> a -> Vec4 a
+vec4 x1 x2 x3 x4 = vecFromList [x1,x2,x3,x4]
+
+vec5 :: a -> a -> a -> a -> a -> Vec5 a
+vec5 x1 x2 x3 x4 x5 = vecFromList [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]
+
+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]
+
+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]
+
+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]
+
+--------------------------------------------------------------------------------
+-- * \"veccing\"
+
+vecVec :: Applicative f => f a -> f a -> f (Vec2 a)
+vecVec t1 t2 = vec2 <$> t1 <*> t2
+
+vecVec3 :: Applicative f => f a -> f a -> f a -> f (Vec3 a)
+vecVec3 t1 t2 t3 = vec3 <$> t1 <*> t2 <*> t3
+
+vecVec4 :: Applicative f => f a -> f a -> f a -> f a -> f (Vec4 a)
+vecVec4 t1 t2 t3 t4 = vec4 <$> t1 <*> t2 <*> t3 <*> t4
+
+vecVec5 :: Applicative f => f a -> f a -> f a -> f a -> f a -> f (Vec5 a)
+vecVec5 t1 t2 t3 t4 t5 = vec5 <$> t1 <*> t2 <*> t3 <*> t4 <*> t5
+
+--------------------------------------------------------------------------------
preprocessor/tpp.hs view
@@ -2,15 +2,17 @@ -- | Tuple brackets preprocessor.
 -- Use like this:
 -- 
--- > {-# OPTIONS -F -pgmF tuplepp #-}
+-- > {-# OPTIONS -F -pgmF tuplepp -optF --tup #-}
+-- > {-# OPTIONS -F -pgmF tuplepp -optF --vec #-}
 --
 -- Write code like this:
 --
 -- > x = {{a,b,c}}
 --
--- and it will be translated to this:
+-- and it will be translated to one of these:
 --
 -- > x = Tup3 a b c 
+-- > x = vec3 a b c 
 -- 
 {-# LANGUAGE PackageImports #-}
 module Main where
@@ -18,6 +20,7 @@ --------------------------------------------------------------------------------
 
 import Data.Char
+import Data.List (intersect)
 
 import Language.Haskell.Exts
 import "parsec2" Text.ParserCombinators.Parsec
@@ -29,20 +32,20 @@ 
 --------------------------------------------------------------------------------
 
-tupleCon :: Int -> Exp
-tupleCon k = Var $ UnQual $ Ident ("Tup" ++ show k)
+tupleCon :: Cfg -> Int -> Exp
+tupleCon (Cfg con) k = Var $ UnQual $ Ident (con {- "Tup"-} ++ show k)
 
-toTupleE :: Exp -> Exp
-toTupleE e = case e of
-  Tuple es -> foldl App (tupleCon (length es)) es
-  _        -> App (tupleCon 1) e
+toTupleE :: Cfg -> Exp -> Exp
+toTupleE cfg e = case e of
+  Tuple es -> foldl App (tupleCon cfg (length es)) es
+  _        -> App (tupleCon cfg 1) e
 
 inparens :: String -> String
 inparens s = "(" ++ s ++ ")"
 
-toTupleS :: String -> String
-toTupleS s = {- trace ("|"++s++"|") $ -} case parseExp (inparens s) of
-  ParseOk e -> pp (toTupleE e)
+toTupleS :: Cfg -> String -> String
+toTupleS cfg s = {- trace ("|"++s++"|") $ -} case parseExp (inparens s) of
+  ParseOk e -> pp (toTupleE cfg e)
   err       -> error ("parse error in idiom bracket:\n" ++ show err)
 
 pp :: Pretty a => a -> String
@@ -104,51 +107,71 @@   Right xx -> xx
   Left err -> error ("preprocessor parse error in file \"" ++ src ++ "\":\n" ++ show err)
 
-convertTupleLine :: TupleLine -> String
-convertTupleLine (S ln) = ln
-convertTupleLine (I pre (b,mid) post) = pre' ++ mid'' ++ post' where
-  pre'  = convertTupleLine pre
-  mid'  = convertTupleLine mid
-  post' = convertTupleLine post
+convertTupleLine :: Cfg -> TupleLine -> String
+convertTupleLine cfg (S ln) = ln
+convertTupleLine cfg (I pre (b,mid) post) = pre' ++ mid'' ++ post' where
+  pre'  = convertTupleLine cfg pre
+  mid'  = convertTupleLine cfg mid
+  post' = convertTupleLine cfg post
   mid''  = if b 
-    then '(' : toTupleS mid' ++ ")"
+    then '(' : toTupleS cfg mid' ++ ")"
     else "{" ++ mid' ++ "}"
     
-processLine :: SourceName -> String -> String    
-processLine src = convertTupleLine . parseLine src
+processLine :: Cfg -> SourceName -> String -> String    
+processLine cfg src = convertTupleLine cfg . parseLine src
     
 --------------------------------------------------------------------------------  
 
+data Cfg = Cfg { _constructor :: String }
+
+tupCfg = Cfg "Tup"
+vecCfg = Cfg "vec"
+
+vecOpts = [ "-v" , "--vec" ]
+tupOpts = [ "-t" , "--tup" ] 
+possibleOpts = vecOpts ++ tupOpts
+
 main :: IO ()
 main = 
   do
-    args <- getArgs
+    args0 <- getArgs
+    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"
+
     case args of
 
-      [] -> interact (f "stdin")
+      [] -> interact (f cfg "stdin")
       [inp] -> do
         text <- readFile inp
-        putStrLn $ f inp text
+        putStrLn $ f cfg inp text
       [inp,out] -> do
         text <- readFile inp
-        writeFile out $ f inp text
+        writeFile out $ f cfg inp text
       [inp,cpp,out] -> do             -- ghc calls the preprocessor this way
         text <- readFile cpp
-        let pptext = f cpp text
+        let pptext = f cfg cpp text
         writeFile out pptext
 
       _ -> do
         print args
         putStrLn $ unlines
           [ "usage:"
-          , "  tpp <input.hs >output.hs"
-          , "  tpp input.hs >output.hs"
-          , "  tpp input.hs output.hs"
-          , "  tpp dummy.hs input.hs output.hs"
+          , "  tpp [options] <input.hs >output.hs"
+          , "  tpp [options] input.hs >output.hs"
+          , "  tpp [options] input.hs output.hs"
+          , "  tpp [options] dummy.hs input.hs output.hs     -- this is for GHC"
+          , "options:"
+          , "  -t, --tup : generates (Tup3 105 106 106) expressions"
+          , "  -v, --vec : generates (vec3 105 106 106) expressions"
           ]
       
   where
-    f src text = processLine src text
+    f cfg src text = processLine cfg src text
 
 --------------------------------------------------------------------------------
tup-functor.cabal view
@@ -1,31 +1,40 @@ 
 Name:                tup-functor
-Version:             0.1
+Version:             0.2
 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.
+                     A small preprocessor for a tuple syntax is also included. We also provide a different implementation 
+                     using type-level programming.
 Author:              Balazs Komuves
 license:             BSD3
 license-file:        LICENSE
 Copyright:           (c) 2012 Balazs Komuves
 Maintainer:          bkomuves (plus) hackage (at) gmail (dot) hu
+Homepage:            http://code.haskell.org/~bkomuves/
 Stability:           Experimental
-Category:            System
+Category:            Data
 Tested-With:         GHC == 7.0.3
 Cabal-Version:       >= 1.6
 Build-Type:          Simple
 
-extra-source-files:  Data/Tup/Tup.inc
+extra-source-files:  Data/Tup/Tup/Tup.inc
+
+source-repository head
+  type:     darcs
+  location: http://code.haskell.org/~bkomuves/projects/tup-functor/
   
 Library
-  Build-Depends:       base >= 3 && < 5
+  Build-Depends:       base >= 3 && < 5, cpphs >= 1.3
 
   Exposed-Modules:     Data.Tup
-                       Data.Tup.Class
-                       Data.Tup.Strict
-                       Data.Tup.Lazy
+                       Data.Tup.Vec
+                       Data.Tup.Tup
+                       Data.Tup.Tup.Class
+                       Data.Tup.Tup.Strict
+                       Data.Tup.Tup.Lazy
+                       Data.Tup.Tup.Concat
 
   Extensions:          CPP
   Hs-Source-Dirs:      .
@@ -33,7 +42,7 @@   -- force-recomp is necessary since all the source code is included via the C preprocessor, 
   -- and thus the recompilation checker is broken
   ghc-options:         -fforce-recomp -Wall -fno-warn-unused-matches -fno-warn-unused-imports -fno-warn-unused-binds
-
+ 
 Executable tuplepp
   Build-Depends:       base >= 3 && < 5, parsec2, haskell-src-exts  
   Main-is:             preprocessor/tpp.hs