diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,29 @@
+BSD 3
+
+All code is copyrighted 2009 by John W. Lato. Usage of this code is governed by the following license.
+
+* Copyright (c) 2009 John W. Lato
+*
+* All rights reserved.
+*
+* Redistribution and use in source and binary forms, with or without
+* modification, are permitted provided that the following conditions are met:
+*     * Redistributions of source code must retain the above copyright
+*       notice, this list of conditions and the following disclaimer.
+*     * Redistributions in binary form must reproduce the above copyright
+*       notice, this list of conditions and the following disclaimer in the
+*       documentation and/or other materials provided with the distribution.
+*     * Neither the name of Tiresias Press nor the
+*       names of its contributors may be used to endorse or promote products
+*       derived from this software without specific prior written permission.
+*
+* THIS SOFTWARE IS PROVIDED BY John W. Lato ``AS IS'' AND ANY
+* EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+* WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
+* DISCLAIMED. IN NO EVENT SHALL John W. Lato OR ANY CONTRIBUTORS BE LIABLE
+* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 
+* SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+* CAUSED ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+* OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+* OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,8 @@
+#! /usr/bin/runhaskell
+
+module Main (main) where
+
+import Distribution.Simple (defaultMain)
+
+main :: IO ()
+main = defaultMain
diff --git a/adaptive-tuple.cabal b/adaptive-tuple.cabal
new file mode 100644
--- /dev/null
+++ b/adaptive-tuple.cabal
@@ -0,0 +1,59 @@
+name:		adaptive-tuple
+version:        0.1.0
+synopsis:       Self-optimizing tuple types
+description:
+  Self optimizing tuple types.
+  .
+  Adaptive tuples are tuple types in which the number of elements is
+  determined at run-time.  These structures are designed to combine
+  the space-efficiency of tuples with the size flexibility of lists.
+  .
+  Adaptive tuples provide lazy and strict, unpacked data structures 
+  for all tuple sizes from 0 to 20 elements.  Adaptive tuples of more than
+  20 elements are allowed, however they are stored in an ordinary list.
+
+category:       Data
+author:		John W. Lato, jwlato@gmail.com
+maintainer:	John W. Lato, jwlato@gmail.com
+license:	BSD3
+license-file:	LICENSE
+homepage:       http://inmachina.net/~jwlato/haskell/
+tested-with:    GHC == 6.12.1, GHC == 6.10.4
+stability:	experimental
+cabal-version:  >= 1.6
+
+build-type:     Simple
+extra-source-files:
+  LICENSE
+
+flag splitBase
+  description: Use the new split-up base package.
+
+library
+ hs-source-dirs:
+   src
+
+ if flag(splitBase)
+   build-depends:
+     base >= 3 && < 5
+ else
+   build-depends:
+     base < 3
+
+ build-depends:
+   haskell98
+   ,type-level >= 0.2 && < 0.3
+   ,template-haskell >= 2.0 && < 3
+
+ exposed-modules:
+   Data.AdaptiveTuple
+   Data.AdaptiveTuple.Reps.Strict
+   Data.AdaptiveTuple.Reps.Lazy
+ other-modules:
+   Data.AdaptiveTuple.AdaptiveTuple
+   Data.AdaptiveTuple.TH
+
+ ghc-options: -Wall
+ if impl(ghc >= 6.8)
+   ghc-options: -fwarn-tabs
+
diff --git a/src/Data/AdaptiveTuple.hs b/src/Data/AdaptiveTuple.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/AdaptiveTuple.hs
@@ -0,0 +1,179 @@
+-- |This module provides support for adaptive tuples.
+-- An `AdaptiveTuple` is a tuple type with the size chosen at run-time and
+-- minimal overhead.  All elements must be of the same type.  Calculations
+-- are generated by combining adaptive tuples, which are then given an
+-- initial input with the `reifyTuple` function or its strict variant.
+--
+-- Example: suppose you have a list of numbers that is either a single list
+-- or multiple interleaved lists.  You wish to determine the maximum value
+-- of the single list or maximums of all interleaved lists.
+--
+-- >  -- |The second  argument is a dummy argument to fix the type of c s ()
+-- >  -- so this function can be used directly with reifyTuple
+-- >  deinterleave :: AdaptiveTuple c s => [Int] -> c s () -> [c s Int]
+-- >  deinterleave [] _ = []
+-- >  deinterleave xs n = let (h, rest) = splitAt (tupLength n) xs
+-- >                      in toATuple h : deinterleave n rest
+-- >
+-- >  maxVals :: AdaptiveTuple c s => [c s Int] -> c s Int
+-- >  maxVals = foldl' (\a b -> max <$> a <*> b) (pure 0)
+-- >
+-- >  runner :: Int -> [Int] -> [Int]
+-- >  runner n xs = reifyStrictTuple n (repeat ())
+-- >                  (fromATuple . maxVals . deinterleave xs)
+--
+-- using AdaptiveTuple is similar to the `ZipList` applicative instance, except
+-- without the overhead.
+
+{-# LANGUAGE MultiParamTypeClasses,
+             FlexibleInstances,
+             FlexibleContexts,
+             ScopedTypeVariables,
+             Rank2Types,
+             GeneralizedNewtypeDeriving,
+             TemplateHaskell #-}
+
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+module Data.AdaptiveTuple (
+  -- * Types
+  -- ** Classes
+  AdaptiveTuple (..)
+  -- ** Exceptions
+  ,AdaptiveTupleException (..)
+  -- * Functions
+  ,reifyTuple
+  ,reifyStrictTuple
+  ,invert
+  ,mapIndexed
+)
+
+where
+
+import Prelude -- hiding (take, drop, splitAt, foldl)
+import qualified Prelude as P
+
+import Data.AdaptiveTuple.AdaptiveTuple
+import qualified Data.AdaptiveTuple.Reps.Lazy as L
+import qualified Data.AdaptiveTuple.Reps.Strict as S
+
+import Data.TypeLevel.Num
+
+import Control.Arrow
+import Control.Applicative
+
+-- helper function
+fI :: (Integral a, Num b) => a -> b
+fI = fromIntegral
+
+-- --------------------------------------------------
+
+-- |Lazily convert a list of AdaptiveTuples into an AdaptiveTuple of lists.
+invert :: (AdaptiveTuple c s) => [c s a] -> c s [a]
+invert []     = pure []
+invert (x:xs) = (:) <$> x <*> invert xs
+
+-- |Map a 0-indexed function over an AdaptiveTuple
+mapIndexed :: (AdaptiveTuple c s) => (Int -> a -> b) -> c s a -> c s b
+mapIndexed f a = f <$> toATuple [0..] <*> a
+
+--reification function
+
+-- |run a computation using a lazy AdaptiveTuple
+reifyTuple :: forall el r. Int -> [el] -> (forall c s. (AdaptiveTuple c s, Nat s) => c s el -> r) -> r
+reifyTuple 0 xs f = f (toATuple xs :: ATuple0 D0 el)
+reifyTuple 1  xs f = f (toATuple xs :: L.ATuple1 D1  el)
+reifyTuple 2  xs f = f (toATuple xs :: L.ATuple2 D2  el)
+reifyTuple 3  xs f = f (toATuple xs :: L.ATuple3 D3  el)
+reifyTuple 4  xs f = f (toATuple xs :: L.ATuple4 D4  el)
+reifyTuple 5  xs f = f (toATuple xs :: L.ATuple5 D5  el)
+reifyTuple 6  xs f = f (toATuple xs :: L.ATuple6 D6  el)
+reifyTuple 7  xs f = f (toATuple xs :: L.ATuple7 D7  el)
+reifyTuple 8  xs f = f (toATuple xs :: L.ATuple8 D8  el)
+reifyTuple 9  xs f = f (toATuple xs :: L.ATuple9 D9  el)
+reifyTuple 10 xs f = f (toATuple xs :: L.ATuple10 D10 el)
+reifyTuple 11 xs f = f (toATuple xs :: L.ATuple11 D11 el)
+reifyTuple 12 xs f = f (toATuple xs :: L.ATuple12 D12 el)
+reifyTuple 13 xs f = f (toATuple xs :: L.ATuple13 D13 el)
+reifyTuple 14 xs f = f (toATuple xs :: L.ATuple14 D14 el)
+reifyTuple 15 xs f = f (toATuple xs :: L.ATuple15 D15 el)
+reifyTuple 16 xs f = f (toATuple xs :: L.ATuple16 D16 el)
+reifyTuple 17 xs f = f (toATuple xs :: L.ATuple17 D17 el)
+reifyTuple 18 xs f = f (toATuple xs :: L.ATuple18 D18 el)
+reifyTuple 19 xs f = f (toATuple xs :: L.ATuple19 D19 el)
+reifyTuple 20 xs f = f (toATuple xs :: L.ATuple20 D20 el)
+reifyTuple n xs f = reifyIntegral n $ \n' -> f (makeListTuple n' xs)
+
+-- |run a computation using a strict AdaptiveTuple
+reifyStrictTuple :: forall el r. Int -> [el] -> (forall c s. (AdaptiveTuple c s, Nat s) => c s el -> r) -> r
+reifyStrictTuple 0 xs f = f (toATuple xs :: ATuple0 D0 el)
+reifyStrictTuple 1  xs f = f (toATuple xs :: S.ATuple1 D1  el)
+reifyStrictTuple 2  xs f = f (toATuple xs :: S.ATuple2 D2  el)
+reifyStrictTuple 3  xs f = f (toATuple xs :: S.ATuple3 D3  el)
+reifyStrictTuple 4  xs f = f (toATuple xs :: S.ATuple4 D4  el)
+reifyStrictTuple 5  xs f = f (toATuple xs :: S.ATuple5 D5  el)
+reifyStrictTuple 6  xs f = f (toATuple xs :: S.ATuple6 D6  el)
+reifyStrictTuple 7  xs f = f (toATuple xs :: S.ATuple7 D7  el)
+reifyStrictTuple 8  xs f = f (toATuple xs :: S.ATuple8 D8  el)
+reifyStrictTuple 9  xs f = f (toATuple xs :: S.ATuple9 D9  el)
+reifyStrictTuple 10 xs f = f (toATuple xs :: S.ATuple10 D10 el)
+reifyStrictTuple 11 xs f = f (toATuple xs :: S.ATuple11 D11 el)
+reifyStrictTuple 12 xs f = f (toATuple xs :: S.ATuple12 D12 el)
+reifyStrictTuple 13 xs f = f (toATuple xs :: S.ATuple13 D13 el)
+reifyStrictTuple 14 xs f = f (toATuple xs :: S.ATuple14 D14 el)
+reifyStrictTuple 15 xs f = f (toATuple xs :: S.ATuple15 D15 el)
+reifyStrictTuple 16 xs f = f (toATuple xs :: S.ATuple16 D16 el)
+reifyStrictTuple 17 xs f = f (toATuple xs :: S.ATuple17 D17 el)
+reifyStrictTuple 18 xs f = f (toATuple xs :: S.ATuple18 D18 el)
+reifyStrictTuple 19 xs f = f (toATuple xs :: S.ATuple19 D19 el)
+reifyStrictTuple 20 xs f = f (toATuple xs :: S.ATuple20 D20 el)
+reifyStrictTuple n xs f = reifyIntegral n $ \n' -> f (makeListTuple n' xs)
+
+-- -------------------------------------------------------
+-- no-element tuple
+
+data ATuple0 s el = ATuple0 deriving (Eq, Show)
+
+instance Functor (ATuple0 D0) where
+  fmap _ _ = ATuple0
+
+instance Applicative (ATuple0 D0) where
+  pure _  = ATuple0
+  _ <*> _ = ATuple0
+
+instance AdaptiveTuple ATuple0 D0 where
+  getIndex _ n   = oObExcp "getIndex"
+  setIndex _ _ _ = ATuple0
+  mapIndex _ _ _ = ATuple0
+  toATuple _     = ATuple0
+  fromATuple _   = []
+
+
+-- |A ListTuple is a List with a type-level length.
+-- to be used when there isn't a more specific adaptive tuple defined
+newtype Nat s => ListTuple s a = ListTuple {getListTuple :: [a]}
+  deriving (Eq, Functor, Show)
+
+-- |Create a ListTuple
+makeListTuple :: Nat s => s -> [a] -> ListTuple s a
+makeListTuple s xs | toInt s P.< P.length xs =
+  error $ "input list to short to make ListTuple of length " ++
+          (show $ toInt s)
+makeListTuple s xs = ListTuple . P.take (toInt s) $ xs
+
+instance Nat s => Applicative (ListTuple s) where
+  pure    = pureLT
+  a <*> b = ListTuple $ zipWith ($) (getListTuple a) (getListTuple b)
+
+pureLT :: forall s a. (Nat s) => a -> ListTuple s a
+pureLT = ListTuple . replicate (toInt (undefined :: s))
+
+instance forall s. (Nat s) => AdaptiveTuple ListTuple s where
+  getIndex z i = getListTuple z !! (fI i)
+  setIndex i el = ListTuple . uncurry (++) . ((++ [el]) *** P.drop 1) .
+                        P.splitAt (fI i) . getListTuple
+  mapIndex f i  = ListTuple . uncurry (++) . second (\(x:xs) -> f x : xs) .
+                        P.splitAt (fI i) . getListTuple
+  toATuple      = makeListTuple (undefined :: s)
+  fromATuple    = getListTuple
+
diff --git a/src/Data/AdaptiveTuple/AdaptiveTuple.hs b/src/Data/AdaptiveTuple/AdaptiveTuple.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/AdaptiveTuple/AdaptiveTuple.hs
@@ -0,0 +1,46 @@
+{-# LANGUAGE MultiParamTypeClasses, ScopedTypeVariables, DeriveDataTypeable #-}
+
+module Data.AdaptiveTuple.AdaptiveTuple (
+  -- *Type classes
+  AdaptiveTuple (..)
+  -- *Types
+  ,AdaptiveTupleException (..)
+  -- *Error functions
+  ,oObExcp
+  ,insExcp
+  )
+
+where
+
+import Data.TypeLevel.Num
+import Data.Data
+import Control.Exception
+import Control.Applicative
+
+-- |Adaptive tuples: unboxed tuples of varying size.
+-- @s@ is a type-level indicator of the number of elements in the container.
+class (Nat s, Applicative (c s)) => AdaptiveTuple c s where
+  getIndex   :: c s el -> Int -> el
+  setIndex   :: Int -> el -> c s el -> c s el
+  mapIndex   :: (el -> el) -> Int -> c s el -> c s el
+  toATuple   :: [el] -> c s el
+  fromATuple :: c s el -> [el]
+  tupLength  :: c s el -> Int
+  tupLength _ = toInt (undefined :: s)
+
+-- -------------------------------------
+-- exceptions
+
+data AdaptiveTupleException =
+    ATupleIndexOutOfBounds String
+  | ATupleInsufficientInput
+  deriving (Show, Typeable)
+
+instance Exception AdaptiveTupleException
+
+oObExcp :: String -> a
+oObExcp = throw . ATupleIndexOutOfBounds
+
+insExcp :: a
+insExcp = throw ATupleInsufficientInput
+
diff --git a/src/Data/AdaptiveTuple/Reps/Lazy.hs b/src/Data/AdaptiveTuple/Reps/Lazy.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/AdaptiveTuple/Reps/Lazy.hs
@@ -0,0 +1,38 @@
+-- | Adaptive tuples with non-strict elements.  It is usually not
+-- necessary to import this module unless you need to construct
+-- custom reification functions.
+
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-matches #-}
+
+module Data.AdaptiveTuple.Reps.Lazy
+
+where
+
+import Data.AdaptiveTuple.TH
+import Data.AdaptiveTuple.AdaptiveTuple
+import Data.TypeLevel.Num
+import Language.Haskell.TH (Strict (..))
+import Control.Applicative
+
+$(makeDatas NotStrict 20)
+$(deriveInstances ''ATuple1 ''D1)
+$(deriveInstances ''ATuple2 ''D2)
+$(deriveInstances ''ATuple3 ''D3)
+$(deriveInstances ''ATuple4 ''D4)
+$(deriveInstances ''ATuple5 ''D5)
+$(deriveInstances ''ATuple6 ''D6)
+$(deriveInstances ''ATuple7 ''D7)
+$(deriveInstances ''ATuple8 ''D8)
+$(deriveInstances ''ATuple9 ''D9)
+$(deriveInstances ''ATuple10 ''D10)
+$(deriveInstances ''ATuple11 ''D11)
+$(deriveInstances ''ATuple12 ''D12)
+$(deriveInstances ''ATuple13 ''D13)
+$(deriveInstances ''ATuple14 ''D14)
+$(deriveInstances ''ATuple15 ''D15)
+$(deriveInstances ''ATuple16 ''D16)
+$(deriveInstances ''ATuple17 ''D17)
+$(deriveInstances ''ATuple18 ''D18)
+$(deriveInstances ''ATuple19 ''D19)
+$(deriveInstances ''ATuple20 ''D20)
diff --git a/src/Data/AdaptiveTuple/Reps/Strict.hs b/src/Data/AdaptiveTuple/Reps/Strict.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/AdaptiveTuple/Reps/Strict.hs
@@ -0,0 +1,39 @@
+-- | Adaptive Tuples with strict fields and unboxed elements.  The equivalent
+-- of @data ATuple1 s n = ATuple1 !n@ compiled with @-funbox-strict-fields@.
+-- It is usually not necessary to import this module except to make custom
+-- reification functions.
+
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}
+{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-unused-binds -fno-warn-unused-matches #-}
+
+module Data.AdaptiveTuple.Reps.Strict
+
+where
+
+import Data.AdaptiveTuple.TH
+import Data.AdaptiveTuple.AdaptiveTuple
+import Data.TypeLevel.Num
+import Language.Haskell.TH (Strict (..))
+import Control.Applicative
+
+$(makeDatas IsStrict 20)
+$(deriveInstances ''ATuple1 ''D1)
+$(deriveInstances ''ATuple2 ''D2)
+$(deriveInstances ''ATuple3 ''D3)
+$(deriveInstances ''ATuple4 ''D4)
+$(deriveInstances ''ATuple5 ''D5)
+$(deriveInstances ''ATuple6 ''D6)
+$(deriveInstances ''ATuple7 ''D7)
+$(deriveInstances ''ATuple8 ''D8)
+$(deriveInstances ''ATuple9 ''D9)
+$(deriveInstances ''ATuple10 ''D10)
+$(deriveInstances ''ATuple11 ''D11)
+$(deriveInstances ''ATuple12 ''D12)
+$(deriveInstances ''ATuple13 ''D13)
+$(deriveInstances ''ATuple14 ''D14)
+$(deriveInstances ''ATuple15 ''D15)
+$(deriveInstances ''ATuple16 ''D16)
+$(deriveInstances ''ATuple17 ''D17)
+$(deriveInstances ''ATuple18 ''D18)
+$(deriveInstances ''ATuple19 ''D19)
+$(deriveInstances ''ATuple20 ''D20)
diff --git a/src/Data/AdaptiveTuple/TH.hs b/src/Data/AdaptiveTuple/TH.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/AdaptiveTuple/TH.hs
@@ -0,0 +1,147 @@
+{-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances, DeriveDataTypeable #-}
+
+{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-incomplete-patterns #-}
+
+module Data.AdaptiveTuple.TH (
+ makeDatas
+ ,makeData
+ ,deriveInstances
+ ,deriveFunctor
+ ,deriveApplicative
+ ,deriveAdaptive
+ )
+where
+
+import Data.AdaptiveTuple.AdaptiveTuple
+import Language.Haskell.TH
+import qualified Data.TypeLevel.Num as T
+import Data.Data
+import Control.Monad
+import Control.Applicative
+import Control.Arrow
+
+checkStrict :: Strict -> Bool
+checkStrict IsStrict = True
+checkStrict _        = False
+
+-- template type for Q Decls
+data T1 s a = T1 a
+
+-- |Generate "ATuple1" ... "ATupleN"
+makeDatas :: Strict -> Int -> Q [Dec]
+makeDatas strict n = liftM concat $ mapM (makeData strict) [1..n]
+
+-- |Given a value n >1, create data value "ATupleN"
+makeData :: Strict -> Int -> Q [Dec]
+makeData strict n = do
+  let dN = mkName $ "ATuple" ++ show n
+  let d' = if checkStrict strict
+              then [d| data MX s a = MX {-# UNPACK #-} !a deriving (Show, Eq, Typeable, Data)|]
+              else [d| data MX s a = MX a deriving (Show, Eq, Typeable, Data)|]
+  d <- d'
+  let [DataD [] _mx tvars [NormalC _mx' [cfield]] ders] = d
+  return [DataD [] dN tvars [NormalC dN (replicate n cfield)] ders]
+
+-- |Generate Functor, Applicative, and AdaptiveTuple instances for type (t s)
+deriveInstances :: Name -> Name -> Q [Dec]
+deriveInstances t s = do
+  fs <- deriveFunctor t s
+  apps <- deriveApplicative t s
+  adpts <- deriveAdaptive t s
+  return $ fs ++ apps ++ adpts
+
+-- |derive Functor instance for type (t s)
+deriveFunctor :: Name -> Name -> Q [Dec]
+deriveFunctor t s = do
+  TyConI (DataD _ _ _ constructors _) <- reify t
+  tT <- conT t                                      -- tuple constructor
+  sT <- conT s                                      --type-level size number
+  d <- [d| instance Functor (T1 s) where fmap _ x = x|]
+  let fmapClause (NormalC name fields) = do
+        (fP:pats, fE:vars) <- genPE (1+length fields)
+        clause (fP:[conP name pats])
+           (normalB (appsE (conE name : map (appE fE) vars))) []
+  let [InstanceD [] (AppT fmapt _) [FunD fmapf _clause]] = d
+  funs <- funD fmapf (map fmapClause constructors)
+  return [InstanceD [] (AppT fmapt (AppT tT sT)) [funs]]
+
+-- |Generate Applicative instance for type (t s)
+deriveApplicative :: Name -> Name -> Q [Dec]
+deriveApplicative t s = do
+  TyConI (DataD _ _ _ constructors _) <- reify t
+  tT <- conT t
+  sT <- conT s
+  d <- [d| instance Functor (T1 s) => Applicative (T1 s) where pure a = T1 a; (T1 a) <*> (T1 b) = T1 (a b)|]
+  let pureClause (NormalC name fields) = do
+        (aP, [aE]) <- genPE 1
+        clause aP (normalB (appsE (conE name:replicate (length fields) aE))) []
+  let appClause (NormalC name fields) = do
+        (aPats, aVars) <- genPE (length fields)
+        (bPats, bVars) <- genPE (length fields)
+        let pats = [conP name aPats, conP name bPats]
+        clause pats (normalB (appsE (conE name:zipWith appE aVars bVars))) []
+  let [InstanceD _ (AppT appt _) [FunD puref _, FunD appf _]] = d
+  purefuncs <- funD puref (map pureClause constructors)
+  appfuncs <- funD appf (map appClause constructors)
+  return [InstanceD [] (AppT appt (AppT tT sT)) [purefuncs, appfuncs]]
+
+-- |Generate AdaptiveTuple instance for type (t s)
+deriveAdaptive :: Name -> Name -> Q [Dec]
+deriveAdaptive t s = do
+  TyConI (DataD _ _ _ constructors _) <- reify t
+  tT <- conT t
+  sT <- conT s
+  d <- [d| instance (T.Nat s, Applicative (T1 s)) => AdaptiveTuple T1 s where getIndex _ _ = undefined; setIndex _ _ c = c; mapIndex _ _ c = c; toATuple _ = undefined; fromATuple _ = []|]
+  let makeClauseOut n pf bf = return $ map ((\(x,y) -> clause x y []) .
+                                (pf &&& bf)) [0..n]
+  let getClauses (NormalC name fields) = do
+        (aP, aV) <- genPE (length fields)
+        ([eP],[eV]) <- genPE 1
+        let getPats n = [conP name aP, litP (integerL (fromIntegral n))]
+        let getBody = normalB . (aV !!)
+        let errC = clause [wildP, eP] (normalB [| oObExcp "getIndex" |]) []
+        c1 <- makeClauseOut (length fields - 1) getPats getBody
+        return (c1 ++ [errC])
+  let setClauses (NormalC name fields) = do
+        ([elP,eP], [elV,eV]) <- genPE 2
+        (aP, aV) <- genPE (length fields)
+        let getPats n = [litP (integerL (fromIntegral n)), elP, conP name aP]
+        let getBody n = normalB $ appsE (conE name:replaceAt aV n elV)
+        let errC = clause [eP, wildP, wildP] (normalB [| oObExcp "setIndex" |]) []
+        c1 <- makeClauseOut (length fields - 1) getPats getBody
+        return (c1 ++ [errC])
+  let mapClauses (NormalC name fields) = do
+        ([fP,eP], [fV,eV]) <- genPE 2
+        (aP, aV) <- genPE (length fields)
+        let getPats n = [fP, litP (integerL (fromIntegral n)), conP name aP]
+        let getBody n = normalB $ appsE
+                          (conE name:replaceAt aV n (appE fV (aV !! n)))
+        let errC = clause [wildP, eP, wildP] (normalB [| oObExcp "mapIndex" |]) []
+        c1 <- makeClauseOut (length fields - 1) getPats getBody
+        return (c1 ++ [errC])
+  let toClauses (NormalC name fields) = do
+        (aP, aV) <- genPE (length fields)
+        let pats = foldr (flip infixP '(:)) wildP aP
+        let c1 = clause [pats] (normalB $ appsE (conE name:aV)) []
+        let c2 = clause [wildP] (normalB [| insExcp |]) []
+        return [c1,c2]
+  let fromClause (NormalC name fields) = do
+        (aP, aV) <- genPE (length fields)
+        clause [conP name aP] (normalB $ listE aV) []
+  let [InstanceD _ (AppT (AppT adtT _) _) [FunD getF _, FunD setF _, FunD mapF _, FunD toATF _, FunD fromATF _]] = d
+  let newty = AppT (AppT adtT tT) sT
+  getters <- mapM getClauses constructors >>= (funD getF . concat)
+  setters <- mapM setClauses constructors >>= (funD setF . concat)
+  maps    <- mapM mapClauses constructors >>= (funD mapF . concat)
+  tos     <- mapM toClauses  constructors >>= (funD toATF . concat)
+  froms   <- funD fromATF (map fromClause constructors)
+  return [InstanceD [] newty [getters,setters,maps,tos,froms]]
+
+-- |Create a list of n Names, with the associated Pat's and Exp's
+genPE :: Int -> Q ([PatQ], [ExpQ])
+genPE n = do
+  ids <- replicateM n (newName "x")
+  return (map varP ids, map varE ids)
+
+replaceAt :: [a] -> Int -> a -> [a]
+replaceAt xs n el = let (f,l) = splitAt n xs in f ++ (el:tail l)