diff --git a/Control/Monad/TagShare.hs b/Control/Monad/TagShare.hs
new file mode 100644
--- /dev/null
+++ b/Control/Monad/TagShare.hs
@@ -0,0 +1,62 @@
+
+-- | A monad for binding values to tags to ensure sharing, 
+-- with the added twist that the value can be polymorphic
+-- and each monomorphic instance is bound separately.
+module Control.Monad.TagShare(
+  -- ** Dynamic map
+  DynMap,
+  dynEmpty,
+  dynInsert,
+  dynLookup,
+  -- ** Sharing monad
+  Sharing,
+  runSharing,
+  share
+  ) where
+import Control.Monad.State
+import Data.Typeable
+import Data.Dynamic(Dynamic, fromDynamic, toDyn)
+import Data.Map as M
+
+-- |  A dynamic map with type safe
+-- insertion and lookup.
+newtype DynMap tag = 
+  DynMap (M.Map (tag, TypeRep) Dynamic) 
+  deriving Show
+
+dynEmpty :: DynMap tag
+dynEmpty = DynMap M.empty  
+  
+dynInsert :: (Typeable a, Ord tag) => 
+                tag -> a -> DynMap tag -> DynMap tag
+dynInsert u a (DynMap m) = 
+          DynMap (M.insert (u,typeOf a) (toDyn a) m)
+
+dynLookup :: (Typeable a, Ord tag) => 
+                tag -> DynMap tag -> Maybe a
+dynLookup u (DynMap m) = hlp fun undefined where 
+    hlp :: Typeable a => 
+      (TypeRep -> Maybe a) -> a -> Maybe a
+    hlp f a = f (typeOf a)
+    fun tr = M.lookup (u,tr) m >>= fromDynamic
+
+ 
+-- | A sharing monad
+-- with a function that binds a tag to a value.
+type Sharing tag a = State (DynMap tag) a
+
+runSharing :: Sharing tag a -> a
+runSharing m = evalState m dynEmpty
+
+share :: (Typeable a, Ord tag) => 
+  tag -> Sharing tag a -> Sharing tag a
+share t m = do
+    mx <- gets $ (dynLookup t)
+    case mx of
+      Just e      ->  return e
+      Nothing     ->  mfix $ \e -> do
+        modify (dynInsert t e)
+        m
+
+
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2011, Jonas Dureg†rd
+
+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 Jonas Dureg†rd nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.lhs b/Setup.lhs
new file mode 100644
--- /dev/null
+++ b/Setup.lhs
@@ -0,0 +1,3 @@
+> import Distribution.Simple
+> main :: IO ()
+> main = defaultMain
diff --git a/Test/Feat.hs b/Test/Feat.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat.hs
@@ -0,0 +1,24 @@
+module Test.Feat(
+  Enumerate(..),
+  -- ** The type class
+  Enumerable(..),
+  nullary,
+  unary,
+  funcurry,
+  consts,
+  deriveEnumerable,
+  FreePair(..),
+  -- ** Accessing data
+  optimised,
+  index,
+  values,
+  bounded,
+  uniform,
+  ioAll,
+  ioBounded  
+  ) where
+
+import Test.Feat.Access
+import Test.Feat.Class
+import Test.Feat.Enumerate
+-- import Test.Feat.Modifiers
diff --git a/Test/Feat/Access.hs b/Test/Feat/Access.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Access.hs
@@ -0,0 +1,156 @@
+-- | Functions for accessing the values of enumerations including 
+-- compatability with the property based testing frameworks QuickCheck and
+-- SmallCheck.
+module Test.Feat.Access(
+  -- ** Accessing functions
+  index,
+  values,
+  striped,
+  bounded,
+  
+  -- ** A simple property tester
+  ioFeat,
+  ioAll,
+  ioBounded,
+  
+  -- ** Compatability
+  -- *** QuickCheck
+  uniform,
+  -- *** SmallCheck
+  toSeries,
+  
+  -- ** Non-class versions of the access functions
+  valuesWith,
+  stripedWith,
+  boundedWith,
+  uniformWith,
+  toSeriesWith
+  )where
+
+-- testing-feat
+import Test.Feat.Enumerate 
+import Test.Feat.Class
+-- base
+import Data.List
+-- quickcheck
+import Test.QuickCheck
+-- smallcheck
+-- import Test.SmallCheck.Series -- Not needed
+
+group :: Enumerate a -> Part -> Index -> Integer
+group e p i = sum (map (card e) [0..p-1]) + i
+
+split :: Enumerate a -> Integer -> (Part, Index)
+split e i0 = go i0 0 where
+  go i p = let crd = card e p in 
+     if i < crd then (p,i)
+     else go (i-crd) (p+1)
+
+-- | Mainly as a proof of concept we can use the isomorphism between 
+-- natural numbers and (Part,Index) pairs to index into a type
+-- May not terminate for finite types.
+-- Might be slow the first time it is used with a specific enumeration 
+-- because cardinalities need to be calculated.
+-- The computation complexity after cardinalities are computed is a polynomial
+-- of the size of the resulting value.
+index :: Enumerate a -> Integer -> a 
+index e = uncurry (select e) . split e
+
+-- | All values of the enumeration by increasing cost (which is the number
+-- of constructors for most types). Also contains the cardinality of each list.
+values :: Enumerable a => [(Integer,[a])]
+values = valuesWith optimised
+
+-- | A generalisation of @values@ that enumerates every nth value of the 
+-- enumeration from a given starting point.
+-- As a special case @values = striped 0 0 1@.
+striped ::  Enumerable a => Part -> Index -> Integer -> [(Integer,[a])]
+striped = stripedWith optimised 
+
+-- | A version of vales that has a limited number of values in each inner list.
+-- If the list corresponds to a Part which is larger than the bound it evenly
+-- intersperses the values across the enumeration of the Part.
+bounded :: Enumerable a => Integer -> [(Integer,[a])]
+bounded = boundedWith optimised
+
+-- | A rather simple but general property testing driver.
+-- The property is a (funcurried) IO function that both tests and reports the 
+-- error. The driver goes on forever or until the list is exhausted, 
+-- reporting the coverage and the number of
+-- tests before each new part.
+ioFeat :: [(Integer,[a])] -> (a -> IO ()) -> IO ()
+ioFeat vs f = go vs 0 where
+  go ((c,xs):xss) s = do
+    putStrLn $ "--- Testing "++show c++" vales at size " ++ show s
+    mapM f xs
+    go xss (s+1)
+  go []           s = putStrLn $ "--- Done. Tested "++ show s++" values"
+
+-- | ioAll = 'ioFeat' values
+ioAll :: Enumerable a => (a -> IO ()) -> IO ()
+ioAll = ioFeat values
+
+-- | ioBounded @n = 'ioFeat' (bounded n)@
+ioBounded :: Enumerable a => Integer -> (a -> IO ()) -> IO ()
+ioBounded n = ioFeat (bounded n)
+
+
+
+-- | Compatability with QuickCheck. Distribution is uniform generator over 
+-- values bounded by the given size. Typical use: @sized uniform@.
+uniform :: Enumerable a => Int -> Gen a
+uniform = uniformWith optimised
+
+-- | Compatability with SmallCheck. 
+toSeries :: Enumerable a => Int -> [a] 
+toSeries = toSeriesWith optimised
+
+-- | Non class version of 'values'.
+valuesWith :: Enumerate a -> [(Integer,[a])]
+valuesWith e = 
+  [(crd,[select e p i|i <- [0..crd - 1]]) 
+    |p <- [0..], let crd = card e p]
+
+-- | Non class version of 'striped'.
+stripedWith :: Enumerate a -> Part -> Index -> Integer -> [(Integer,[a])]
+stripedWith e p o step = if space <= 0 
+  then (0,[]) : stripedWith e (p+1) (o - crd) step
+  else (d,thisP) : stripedWith e (p+1) (step-m-1) step
+  where
+    thisP = 
+      [select e p x|x <- genericTake d $ iterate (+step) o]
+    space = crd - o
+    (d,m) = divMod space step
+    crd = card e p
+
+-- | Non class version of 'bounded'.
+boundedWith :: Enumerate a -> Integer -> [(Integer,[a])]
+boundedWith e n = map (samplePart e n) [0..]
+
+samplePart :: Enumerate a -> Index -> Part -> (Integer,[a])
+samplePart e m p = 
+  let
+    top   =  toRational $ (card e p) - 1
+    step  =  top / toRational (m-1) 
+    crd = card e p
+  in if toRational m >= top 
+       then (crd, map (select e p) [0..crd - 1])
+       else let d = floor ((toRational crd)/ step) in 
+         (d+1,[select e p (round (k * step))|k <- map toRational [0..d]])
+
+-- | Non class version of 'uniform'.
+uniformWith :: Enumerate a -> Part -> Gen a
+uniformWith e maxp = let
+  cards  = [(card e x, x) | x <- [maxp, maxp-1 .. 0]]
+  tot    = sum $ fst $ unzip cards
+  in if tot == 0 then uniformWith e (maxp+1) else do
+    i <- choose (0,tot-1)
+    return $ uncurry (select e) (lu i cards)
+  where
+    lu i ((crd,p):xs)  = if i<crd 
+      then (p,i) 
+      else lu (i-crd) xs
+      
+-- | Non class version of 'toSeries'.
+toSeriesWith :: Enumerate a -> Int -> [a]
+toSeriesWith e d = concat (take (d+1) $ map snd $ valuesWith e)
diff --git a/Test/Feat/Class.hs b/Test/Feat/Class.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Class.hs
@@ -0,0 +1,246 @@
+{-#LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
+
+-- | Everything you need to construct an enumeration for an algebraic type.
+-- Just define each constructor using pure for nullary constructors and 
+-- unary and funcurry for positive arity constructors, then combine the 
+-- constructors with consts. Example:
+-- 
+-- @
+--  instance Enumerable a => Enumerable [a] where
+--    enumerate = consts [unary (funcurry (:)), pure []]
+-- @
+--
+-- There's also a handy Template Haskell function for automatic derivation.
+
+
+module Test.Feat.Class (
+  Enumerable(..),
+  
+  -- ** Building instances
+  Constructor,
+  nullary,
+  unary,
+  funcurry,
+  consts,
+  
+  -- ** Accessing the enumerator of an instance
+  optimised,
+  
+  -- *** Free pairs
+  FreePair(..),
+  
+  
+  -- ** Deriving instances with template haskell
+  deriveEnumerable,
+  -- autoCon,
+  -- autoCons
+  
+  
+
+  ) where
+
+-- testing-feat
+import Test.Feat.Enumerate
+import Test.Feat.Internals.Tag(Tag(Class))
+import Test.Feat.Internals.Derive
+-- base
+import Data.Typeable
+-- template-haskell
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+-- base - only for instances
+import Data.Word
+import Data.Int
+import Data.Bits
+
+-- | A class of functionally enumerable types
+class Typeable a => Enumerable a where
+  -- | This is the interface for defining an instance. Memoisation needs to 
+  -- be ensured e.g. using 'mempay' but sharing is handled automatically by 
+  -- the default implementation of 'shared'.
+  enumerate  :: Enumerate a
+  
+  -- | Version of enumerate that ensures it is shared between
+  -- all accessing functions. Should alwasy be used when 
+  -- combining enumerations.
+  -- Should typically be left to default behaviour.
+  shared     :: Enumerate a
+  shared  = tagShare Class enumerate
+
+-- | An optimised version of enumerate. Used by all
+-- library functions that access enumerated values (but not 
+-- by combining functions). Library functions should ensure that 
+-- @optimised@ is not reevaluated.
+optimised :: Enumerable a => Enumerate a
+optimised = optimise shared   
+
+-- | A free pair constructor. The cost of constructing a free pair
+-- is equal to the sum of the costs of its components. 
+newtype FreePair a b = Free {free :: (a,b)} 
+  deriving (Show, Typeable)
+
+-- | Uncurry a function (typically a constructor) to a function on free pairs.
+funcurry :: (a -> b -> c) -> FreePair a b -> c
+funcurry f = uncurry f . free
+
+instance (Enumerable a, Enumerable b) => 
+         Enumerable (FreePair a b) where
+  enumerate = mem $ curry Free <$> shared <*> shared
+
+type Constructor = Enumerate
+  
+-- | For nullary constructors such as @True@ and @[]@.
+nullary :: a -> Constructor a
+nullary = pure
+
+-- | For any non-nullary constructor. Apply 'funcurry' until the type of
+-- the result is unary (i.e. n-1 times where n is the number of fields 
+-- of the constructor).
+unary :: Enumerable a => (a -> b) -> Constructor b
+unary f = f <$> shared
+
+-- | Produces the enumeration of a type given the enumerators for each of its
+-- constructors. The result of 'unary' should typically not be used 
+-- directly in an instance even if it only has one constructor. So you 
+-- should apply consts even in that case. 
+consts :: [Constructor a] -> Enumerate a
+consts xs = mempay $ mconcat xs 
+
+
+--------------------------------------------------------------------
+-- Automatic derivation
+
+-- | Derive an instance of Enumberable with Template Haskell.
+deriveEnumerable :: Name -> Q [Dec]
+deriveEnumerable = fmap return . instanceFor ''Enumerable [enumDef]
+
+-- -- | Derive the enumeration of a single constructor. Useful 
+-- if 'deriveEnumerable' does not work for all constructors. 
+-- autoCon :: Name -> Q Exp
+-- autoCon = undefined
+
+-- -- | Splices a list of automatically derived constructors.
+-- autoCons :: [Name] -> Q Exp
+-- autoCons = listE . map autoCon
+
+enumDef :: [(Name,[Type])] -> [Q Dec]
+enumDef cons = [fmap mk_freqs_binding [|consts $ex |]] where
+  ex = listE $ map cone cons
+  cone (n,[]) = [|pure $(conE n)|]
+  cone (n,_:vs) = 
+    [|unary $(foldr appE (conE n) (map (const [|funcurry|] ) vs) )|]
+  mk_freqs_binding :: Exp -> Dec
+  mk_freqs_binding e = ValD (VarP 'enumerate) (NormalB e) []
+
+
+
+
+
+---------------------------------------------------------------------
+-- Instances
+
+
+(let 
+  it = mapM (instanceFor ''Enumerable [enumDef]) 
+    [ ''[] 
+    , ''Bool
+    , ''()
+    , ''(,)
+    , ''(,,)
+    , ''(,,,)
+    , ''(,,,,)
+    , ''(,,,,,)
+    , ''(,,,,,,) -- This is as far as typeable goes...
+    , ''Either
+    , ''Maybe
+    , ''Ordering
+    ]
+  -- Circumventing the stage restrictions by means of code repetition.
+  enumDef :: [(Name,[Type])] -> [Q Dec]
+  enumDef cons = [fmap mk_freqs_binding [|consts $ex |]] where
+    ex = listE $ map cone cons
+    cone (n,[]) = [|pure $(conE n)|]
+    cone (n,_:vs) = 
+      [|unary $(foldr appE (conE n) (map (const [|funcurry|] ) vs) )|]
+    mk_freqs_binding :: Exp -> Dec
+    mk_freqs_binding e = ValD (VarP 'enumerate) (NormalB e) []
+  in it)
+  
+
+
+-- This instance is quite important. It needs to be exponential for 
+-- the other instances to work.
+newtype Natural = Natural {natural :: Integer} deriving (Typeable, Show)
+instance Enumerable Natural where 
+  enumerate = let e = Enumerate{
+    card = crd,
+    select = sel,
+    optimal = return e} in e where
+      crd p
+        | p <= 0     = 0
+        | p == 1     = 1
+        | otherwise  = 2^(p-2)
+      sel 1 0 = Natural 0
+      sel p i = Natural $ 2^(p-2) + i
+
+-- This instance is used by the Int* instances and needs to be exponential as 
+-- well.
+instance Enumerable Integer where 
+  enumerate = unary f  where
+    f (Free (b,Natural i)) = if b then -i-1 else i
+           
+
+-- An exported version would have to use $tag instead of Class
+word :: (Bits a, Integral a) => Enumerate a 
+word = e where
+  e = cutOff (bitSize' e+1) $ unary (fromInteger . natural)
+  
+int :: (Bits a, Integral a) => Enumerate a 
+int = e where
+  e = cutOff (bitSize' e+1) $ unary fromInteger
+
+cutOff :: Int -> Enumerate a -> Enumerate a 
+cutOff n e = e{
+  card = \p -> if p > n then 0 else card e p, 
+  optimal = fmap (cutOff n) $ optimal e
+  }
+
+bitSize' :: Bits a => f a -> Int
+bitSize' f = hlp undefined f where
+  hlp :: Bits a => a -> f a -> Int
+  hlp a _ = bitSize a
+
+instance Enumerable Word where
+  enumerate = word
+instance Enumerable Word8 where
+  enumerate = word
+instance Enumerable Word16 where
+  enumerate = word
+instance Enumerable Word32 where
+  enumerate = word
+instance Enumerable Word64 where
+  enumerate = word
+
+instance Enumerable Int where
+  enumerate = int
+instance Enumerable Int8 where
+  enumerate = int
+instance Enumerable Int16 where
+  enumerate = int
+instance Enumerable Int32 where
+  enumerate = int
+instance Enumerable Int64 where
+  enumerate = int
+
+-- | Not injective
+instance Enumerable Double where
+  enumerate = unary (funcurry encodeFloat)
+
+-- | Not injective
+instance Enumerable Float where
+  enumerate = unary (funcurry encodeFloat)
+
+-- | Contains only ASCII characters
+instance Enumerable Char where
+  enumerate = cutOff 8 $ unary (toEnum . fromIntegral :: Word -> Char)
+
diff --git a/Test/Feat/Enumerate.hs b/Test/Feat/Enumerate.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Enumerate.hs
@@ -0,0 +1,162 @@
+{-#LANGUAGE DeriveDataTypeable, TemplateHaskell #-}
+
+-- | Basic combinators fo building enumerations
+-- most users will want to use the type class 
+-- based combinators in "Test.Feat.Class" instead. 
+
+module Test.Feat.Enumerate(
+  
+  Part,
+  Index,
+  Enumerate(..),
+  
+  -- ** Combinators for building enumerations
+  module Control.Applicative,
+  module Data.Monoid,
+  pay,
+  
+  -- ** Memoisation
+  mem,
+  mempay,
+    
+  -- *** Polymorphic memoisation
+  module Data.Typeable,
+  Tag(Source),
+  tag,
+  tagShare,
+  optimise  
+  ) where
+
+-- testing-feat
+import Control.Monad.TagShare(Sharing, runSharing, share)
+import Test.Feat.Internals.Tag(Tag(Source))
+-- base
+import Control.Applicative
+import Control.Monad
+import Data.Monoid
+import Data.Typeable
+import Language.Haskell.TH
+-- data-memocombinators
+import Data.MemoCombinators
+
+
+
+type Part = Int
+type Index = Integer
+
+-- | A functional enumeration of type t is a partition of
+-- t into finite numbered sets called Parts. The number that
+-- identifies each part is called the cost of the values in 
+-- that part.
+data Enumerate a = Enumerate
+   {  
+   -- | Computes the cardinality of a given part.
+   card      ::  Part -> Index,
+   -- | Selects a value from the enumeration
+   -- For @select e p i@, @i@ should be less than @card e p@
+   select    ::  Part -> Index -> a,
+   -- | A self-optimising function. 
+   optimal   ::  Sharing Tag (Enumerate a)
+   } deriving Typeable     
+
+-- | Only use fmap with bijective functions (e.g. data constructors)
+instance Functor Enumerate where 
+  fmap f cf = cf
+    {select    = \p n -> f (select cf p n)
+    , optimal  = liftM (fmap f) (optimal cf) }
+
+-- | mappend = union
+instance Monoid (Enumerate a) where
+  mempty      = let e = Enumerate  (\p -> 0) 
+                                   (\p i -> error "select: empty")
+                                   (return e) in e
+  mappend     = union
+
+-- | Disjoint union
+union :: Enumerate a -> Enumerate a -> Enumerate a
+union a b  =  infinite part (liftM2 union (optimal a) (optimal b)) where
+  part p   =  finUnion (finite a p) (finite b p)
+
+-- | <*> corresponds to product (as with lists)
+instance Applicative Enumerate where
+  pure     = singleton
+  f <*> a  = fmap (uncurry ($)) (cartesian f a)
+
+-- | The product of two enumerations
+cartesian :: Enumerate a -> Enumerate b -> Enumerate (a,b)
+cartesian a b = infinite (\p -> foldl1 finUnion
+  [finCart (finite a x) (finite b (p-x))| x <- [0..p]])
+    (liftM2 cartesian (optimal a) (optimal b))
+
+-- | The definition of @pure@ for the applicaive instance. 
+singleton :: a -> Enumerate a
+singleton a = let e = Enumerate car sel (return e) in e 
+  where  car p    = if p == 0 then 1 else 0
+         sel 0 0  = a
+         sel _ _  = 
+           error "select: index out of bounds"
+
+-- | Increases the cost of all values in an enumeration by one.
+pay :: Enumerate a -> Enumerate a
+pay sel = Enumerate
+    {  card      = \p -> if p <= 0 then 0 else card sel (p-1)
+    ,  select    = \p -> select sel (p-1)
+    ,  optimal   = liftM pay (optimal sel)
+    }
+
+-------------------------------------------------------
+-- Memoisation
+
+mem :: Enumerate a -> Enumerate a
+mem sel = sel
+    { card      = bits (card sel)
+    , optimal   = fmap mem (optimal sel)
+    }
+
+-- | A conventient combination of memoisation and guarded recursion.
+mempay :: Enumerate a -> Enumerate a
+mempay = mem . pay
+           
+
+-------------------------------------------------------
+-- Polymorphic memoisation
+tag :: Q Exp -- :: Tag
+tag = location >>= makeTag where
+   makeTag Loc{  loc_package  = p,    
+                 loc_module   = m,    
+                 loc_start    = (r,c) }
+       = [|Source p m r c|]
+
+tagShare :: Typeable a => Tag -> Enumerate a -> Enumerate a
+tagShare t e = e{optimal = share t (optimal e)}
+
+optimise :: Enumerate a -> Enumerate a
+optimise e = let e' = runSharing (optimal e) in
+  e'{optimal = return e'}   
+
+           
+--------------------------------------------------------
+-- Operations on finite sets
+data Finite a = Finite {fCard :: Index, fSelect :: Index -> a}
+
+finite :: Enumerate a -> Part -> Finite a
+finite e p = Finite (card e p) (select e p) 
+
+infinite :: (Part -> Finite a) -> Sharing Tag (Enumerate a) -> Enumerate a
+infinite f m = Enumerate (fCard . f) (fSelect . f) m
+
+finUnion :: Finite a -> Finite a -> Finite a
+finUnion f1 f2 = Finite car sel where
+  car = fCard f1 + fCard f2
+  sel i = if i < fCard f1
+    then fSelect f1 i
+    else fSelect f2 (i-fCard f1)  
+
+finCart :: Finite a -> Finite b -> Finite (a,b)
+finCart f1 f2 = Finite car sel where
+  car = fCard f1 * fCard f2
+  sel i = let (q, r) = (i `quotRem` fCard f2) 
+    in (fSelect f1 q, fSelect f2 r)
+
+
+
diff --git a/Test/Feat/Internals/Derive.hs b/Test/Feat/Internals/Derive.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Internals/Derive.hs
@@ -0,0 +1,48 @@
+{-#Language TemplateHaskell#-}
+module Test.Feat.Internals.Derive where
+import Language.Haskell.TH
+
+-- General combinator for class derivation
+instanceFor :: Name -> [[(Name,[Type])] -> [Q Dec]] -> Name -> Q Dec
+instanceFor clname confs dtname = do
+  (cxt,dtvs,cons) <- extractData dtname
+  cd              <- mapM conData cons
+  let 
+    mkCxt = fmap (cxt++) $ mapM (classP clname . return . varT) dtvs
+    mkTyp = mkInstanceType clname dtname dtvs
+    mkDecs conf = conf cd
+
+  instanceD mkCxt mkTyp (concatMap mkDecs confs)
+
+
+mkInstanceType :: Name -> Name -> [Name] -> Q Type
+mkInstanceType cn dn vns = appT (conT cn) (foldl (appT) (conT dn) (map varT vns))
+
+extractData :: Name -> Q (Cxt, [Name], [Con])
+extractData n = reify n >>= \i -> return $ case i of
+  TyConI (DataD cxt _ tvbs cons _)   -> (cxt, map tvbName tvbs, cons)
+  TyConI (NewtypeD cxt _ tvbs con _) -> (cxt, map tvbName tvbs, [con])
+  _ -> error $ "Unexpected info: " ++ show (ppr i)
+
+tvbName :: TyVarBndr -> Name
+tvbName (PlainTV n)  = n
+tvbName (KindedTV n _) = n
+
+
+conData :: Con -> Q (Name,[Type])
+conData c = case c of
+  NormalC n sts    -> return (n,map snd sts)
+  RecC n vsts      -> return (n,map (\(_,s,t) -> t) vsts)
+  InfixC st1 n st2 -> return (n,[snd st1,snd st2])
+  ForallC _ _ c'   -> conData c'
+
+
+x :: IO Type
+x = runQ $ (toType ''(,)) 
+  
+
+toType n = case lookup n tups of
+  Nothing -> conT n
+  Just q  -> q
+
+tups = (''(), [t|()|]):map (\(n,i) -> (n, tupleT i)) (zip [''(,), ''(,,)] [2..])
diff --git a/Test/Feat/Internals/Tag.hs b/Test/Feat/Internals/Tag.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Internals/Tag.hs
@@ -0,0 +1,5 @@
+module Test.Feat.Internals.Tag where
+
+data Tag  =  Class                       
+          |  Source String String Int Int
+   deriving (Show,Eq,Ord)  
diff --git a/Test/Feat/Modifiers.hs b/Test/Feat/Modifiers.hs
new file mode 100644
--- /dev/null
+++ b/Test/Feat/Modifiers.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-- | Types with invariants. Currently these are mostly examples of how to 
+-- define such types, suggestions on useful types are appreciated.
+--
+-- To use the invariant types you can use the record label. For instance:
+--
+-- @
+--  data C a = C [a] [a] deriving Typeable
+--  instance Enumerable a => Enumerable (C a) where
+--     enumerate = unary $ funcurry $ 
+--       \xs ys -> C (nonEmpty xs) (nonEmpty ys)
+-- @
+--
+-- Alternatively you can put everything in pattern postition:
+--
+-- @
+--  instance Enumerable a => Enumerable (C a) where
+--     enumerate = unary $ funcurry $ 
+--       \(Free (NonEmpty xs,NonEmpty ys)) -> C xs ys)
+-- @
+--
+-- The first approach has the advantage of being usable with a 
+-- point free style: @ \xs -> C (nonEmpty xs) . nonEmpty @.
+module Test.Feat.Modifiers(
+  NonEmpty(..),
+  mkNonEmpty,
+
+  Nat(..),
+    
+  ) where
+
+-- testing-feat
+import Test.Feat.Enumerate 
+import Test.Feat.Class
+-- quickcheck -- Should be made compatible at some point.
+-- import Test.QuickCheck.Modifiers
+
+
+-- | A type of non empty lists.
+newtype NonEmpty a = NonEmpty {nonEmpty :: [a]} 
+  deriving (Typeable, Show)
+mkNonEmpty x xs = x:xs
+instance Enumerable a => Enumerable (NonEmpty a) where
+  enumerate = unary NonEmpty
+
+-- Copy paste from Enumerate.hs
+-- | A type of natural numbers.
+newtype Nat = Nat {nat :: Integer} 
+  deriving (Typeable, Show)
+instance Enumerable Nat where 
+  enumerate = let e = Enumerate{
+    card = crd,
+    select = sel,
+    optimal = return e} in e where
+      crd p
+        | p <= 0     = 0
+        | p == 1     = 1
+        | otherwise  = 2^(p-2)
+      sel 1 0 = Nat 0
+      sel p i = Nat $ 2^(p-2) + i
+
+
diff --git a/examples/TestTH.hs b/examples/TestTH.hs
new file mode 100644
--- /dev/null
+++ b/examples/TestTH.hs
@@ -0,0 +1,451 @@
+{-#LANGUAGE MagicHash, TemplateHaskell, DeriveDataTypeable, StandaloneDeriving, GeneralizedNewtypeDeriving #-} 
+-- BangPatterns, ScopedTypeVariables, ViewPatterns, KindSignatures
+
+module TestTH where 
+
+import Language.Haskell.TH.Syntax
+  ( Exp(..), Pat(..), Stmt(..), Type(..), Dec(..), 
+    Range(..), Lit(..), Kind(..), 
+    Body(..), Guard(..), Con(..), Match(..), 
+    Name(..), mkName, NameFlavour(..), NameSpace(..), 
+    Clause(..), Pragma(..), FamFlavour(..), 
+    Pred(..), TyVarBndr(..), 
+    Foreign, Callconv(..), FunDep(..), 
+    Safety(..), Strict(..), InlineSpec(..))
+-- testing-feat
+import Test.Feat
+import Test.Feat.Access
+import Test.Feat.Modifiers
+-- template-haskell
+import Language.Haskell.TH.Syntax.Internals(OccName(OccName), ModName(ModName), PkgName)
+import Language.Haskell.TH.Ppr(pprint,Ppr)
+-- haskell-src-meta
+import Language.Haskell.Meta(toExp)
+-- haskell-src-exts
+import qualified Language.Haskell.Exts as E
+-- quickcheck
+import Test.QuickCheck hiding (NonEmpty, (><))
+--base
+import Data.Typeable(Typeable)
+import Data.Ord
+import Data.List
+-- smallcheck
+import Test.SmallCheck.Series hiding (Nat)
+import Test.SmallCheck
+
+-- Currently both of these spit out a lot of errors. Disabling a few of the
+-- buggier constructors might help.
+test_parsesAll = ioAll report_parses
+test_parsesBounded = ioBounded 10000 report_parses
+
+report_parses e = case prop_parsesM e of
+    Nothing -> return ()
+    Just s  -> do
+               putStrLn "Failure:"
+               putStrLn (pprint e)
+               print e
+               putStrLn s
+               putStrLn ""
+
+prop_parsesM e = case myParse $ pprint (e :: Exp) :: E.ParseResult E.Exp of
+  E.ParseOk _       -> Nothing
+  E.ParseFailed _ s -> Just s
+
+
+test_cycleAll = ioAll report_cycle
+test_cycleBounded = ioBounded 10000 report_cycle
+report_cycle e = case prop_cycle e of
+    Nothing       -> return ()
+    Just (ee,ex)  -> do
+               putStrLn "Failure:"
+               putStrLn (pprint ex)
+               print ex
+               putStrLn (E.prettyPrint  ee)
+               putStrLn ""
+
+-- Round-trip property: TH -> String -> HSE -> TH
+-- Uses haskell-src-meta for HSE -> TH
+prop_cycle :: Exp -> Maybe (E.Exp,Exp)
+prop_cycle e = case myParse $ pprint (e :: Exp) :: E.ParseResult E.Exp of
+  E.ParseOk hse       -> if e == toExp hse then Nothing else Just $ (hse, toExp hse)
+  E.ParseFailed _ s   -> Nothing -- Parse failures do not count as errors!
+
+
+
+-- Haskell parser
+myParse :: String -> E.ParseResult E.Exp
+myParse = E.parseWithMode E.defaultParseMode{E.extensions = 
+    [ E.BangPatterns
+    , E.ScopedTypeVariables
+    , E.ViewPatterns
+    , E.KindSignatures
+    , E.ExplicitForAll
+    , E.TypeFamilies
+    ]}
+
+
+
+  
+-- We define both SmallCheck and Feat enumerators for comparison.  
+c1 :: (Serial a, Enumerable a) => (a -> b) -> (Enumerate b, Series b)
+c1 f = (unary f,cons1 f)
+c0 f = (nullary f, cons0 f)
+
+instance (Serial a, Serial b) => Serial (FreePair a b) where
+  series = map Free . (series >< series) 
+  coseries = undefined
+
+toSel :: [(Enumerate b, Series b)] -> Enumerate b
+toSel xs = consts $ map fst xs
+
+toSerial :: [(Enumerate b, Series b)] -> Series b
+toSerial xs = foldl1 (\/) $ map snd xs
+
+
+
+-- These statements are always expressions
+newtype ExpStmt = ExpStmt Exp deriving Typeable
+
+-- Declarations allowed in where clauses
+newtype WhereDec = WhereDec{unWhere :: Dec} deriving Typeable
+
+-- Lowecase names
+newtype LcaseN = LcaseN {lcased :: Name} deriving Typeable
+-- Uppercase names
+newtype UpcaseName = UpcaseName {ucased :: Name} deriving Typeable
+newtype BindN = BindN Name deriving Typeable
+
+
+instance (Enumerable a, Serial a) => Serial (NonEmpty a) where
+  series = toSerial [c1 $ NonEmpty . funcurry (:)] 
+  coseries = undefined 
+  
+instance Serial Nat where
+  series = map (\(N a) -> Nat a) . series
+  coseries = undefined 
+
+
+newtype CPair a b = CPair {cPair :: (a,b)} deriving Typeable
+
+instance (Enumerable a, Serial a,Enumerable b, Serial b) => Serial (CPair a b) where
+  series = toSerial [c1 $ CPair . funcurry (,)] 
+  coseries = undefined 
+instance (Serial a,Enumerable a,Enumerable b, Serial b) => Enumerable (CPair a b) where
+  enumerate = toSel [c1 $ CPair . funcurry (,)] 
+
+cExp =   
+  [c1 $ VarE . lcased
+  ,c1 $ ConE . ucased
+  ,c1 LitE
+  ,c1 $ funcurry AppE
+  ,c1 $ \(ExpStmt a,o)   -> InfixE (Just a) (either ConE VarE o) Nothing
+  ,c1 $ \(ExpStmt a,o)   -> InfixE Nothing  (either ConE VarE o) (Just a)
+  ,c1 $ \(a,o,b) -> InfixE (Just a) (either ConE VarE o) (Just b)
+--  ,c1 $ funcurry $ funcurry $ \a o b -> UInfixE a (VarE o) b
+--  ,c1 $ funcurry $ funcurry $ \a o b -> UInfixE a (ConE o) b 
+--  ,c1 ParensE
+  ,c1 $ funcurry $ LamE . nonEmpty
+  ,c1 $ \(x1,x2,xs) -> TupE (x1:x2:xs)
+--  ,c1 UnboxedTupE
+  ,c1 $ funcurry $ funcurry CondE
+  ,c1 $ \(d,ds,e) -> LetE (map unWhere $ d:ds) e -- DISABLED BUGGY EMPTY LETS
+  ,c1 $ \(e,NonEmpty m) -> CaseE e m
+  ,c1 $ \(e,ss) -> DoE (ss ++ [NoBindS e])
+  ,c1 $ (\((p,e),(CPair (xs,e'))) -> CompE ([BindS p e] ++ xs ++ [NoBindS e']))
+--  ,c1 ArithSeqE -- BUGGY!
+  ,c1 ListE
+--  ,c1 $ funcurry SigE -- BUGGY!
+  ,c1 $ \(e,x) -> RecConE e $ map unCase (nonEmpty x)
+  ,c1 $ \(e,fe) -> RecUpdE e $ map unCase (nonEmpty fe)
+  ]
+instance Enumerable Exp where
+  enumerate = toSel cExp
+instance Serial Exp where
+  series = toSerial cExp
+  coseries = undefined
+
+unCase (LcaseN n,e) = (n,e)
+
+cExpStmt = 
+  [ c1 $ ExpStmt . VarE
+  , c1 $ ExpStmt . ConE
+  , c1 $ ExpStmt . LitE
+  , c1 $ \(e1,e2) -> ExpStmt (AppE e1 e2)
+  , c1 $ ExpStmt . LitE
+  -- , c1 parS
+  -- Removed paralell comprehensions
+  ]
+instance Enumerable ExpStmt where
+ enumerate = toSel cExpStmt
+instance Serial ExpStmt where
+  series = toSerial cExpStmt
+  coseries = undefined
+  
+cPat =   
+  [ c1 LitP
+  , c1 $ \(BindN n) -> VarP n
+  , c1 TupP 
+  , c1 $ \(UpcaseName n,ps) -> ConP n ps
+  , c1 $ \(p1,UpcaseName n,p2) -> InfixP p1 n p2
+  , c1 TildeP
+--  , c1 $ \(LcaseN n) -> BangP $ VarP n
+  , c1 $ \(BindN n,p) -> AsP n p
+  , c0 WildP
+  , c1 $ \(UpcaseName e,x) -> RecP e (map (\(BindN n, p) -> (n,p)) (nonEmpty x))
+  , c1 ListP
+--  , c1 $ funcurry SigP -- BUGGY!
+--  , c1 $ funcurry ViewP -- BUGGY!
+  ]
+instance Enumerable Pat where
+ enumerate = toSel cPat
+instance Serial Pat where
+  series = toSerial cPat
+  coseries = undefined
+
+
+
+-- deriveEnumerable ''Match  -- Should remove decs
+cMatch = 
+  [c1 $ funcurry $ funcurry $ \x y ds -> Match x y (map unWhere ds)
+  ]
+instance Enumerable Match where
+ enumerate = toSel cMatch
+instance Serial Match where
+  series = toSerial cMatch
+  coseries = undefined  
+  
+cStmt = 
+  [ c1 $ funcurry BindS
+  , c1 $ \(d) -> LetS $ map unWhere $ nonEmpty d
+  , c1 $ NoBindS
+  -- , c1 parS
+  -- Removed paralell comprehensions
+  ]
+instance Enumerable Stmt where
+ enumerate = toSel cStmt
+instance Serial Stmt where
+  series = toSerial cStmt
+  coseries = undefined
+
+
+cName = [ c1 (funcurry Name) ]
+instance Enumerable Name where
+ enumerate = toSel cName
+instance Serial Name where
+  series = toSerial cName
+  coseries = undefined
+
+cType = 
+  [c1 $ funcurry $ funcurry $ (\(x) -> ForallT (nonEmpty x))
+  ,c1 $ \(BindN a) -> VarT a
+  ,c1 $ \(UpcaseName a) -> ConT a
+  ,c1 $ \n -> TupleT (abs n)
+  ,c0 ArrowT
+  ,c0 ListT
+  ,c1 $ funcurry AppT
+  -- ,c1 $ funcurry SigT -- BUGGY!
+  ]
+instance Enumerable Type where
+ enumerate = toSel cType
+instance Serial Type where
+  series = toSerial cType
+  coseries = undefined
+
+
+-- deriveEnumerable ''Dec
+
+cWhereDec = 
+  [ c1 $ \(n,c)  -> WhereDec $ FunD n (nonEmpty c)
+  , c1 $ \(n,p,wds) -> WhereDec $ ValD n p (map unWhere wds)
+  , c1 $ \(BindN a,b)     -> WhereDec $ SigD a b
+  -- , c1 $ WhereDec . PragmaD -- Removed pragmas
+  -- , c1 parS -- Removed paralell comprehensions
+  ]
+instance Enumerable WhereDec where
+  enumerate = toSel cWhereDec
+instance Serial WhereDec where
+  series = toSerial cWhereDec
+  coseries = undefined
+
+
+  
+cLit = 
+  [ c1 StringL
+  , c1 CharL    -- TODO: Fair char generation
+  , c1 $ IntegerL . nat
+  -- , c1 RationalL -- BUGGY!
+  -- Removed primitive litterals
+  ]
+instance Enumerable Lit where
+  enumerate = toSel cLit
+instance Serial Lit where
+  series = toSerial cLit
+  coseries = undefined
+
+
+cClause = 
+ [c1 $ funcurry (funcurry $ \ps bs ds -> Clause ps bs (map unWhere ds))]
+instance Enumerable Clause where
+  enumerate = toSel cClause
+instance Serial Clause where
+  series = toSerial cClause
+  coseries = undefined
+
+
+
+
+
+-- deriveEnumerable ''Pred
+cPred = 
+  [ c1 $ funcurry ClassP
+  , c1 $ funcurry EqualP
+  ]
+instance Enumerable Pred where
+  enumerate = toSel cPred
+instance Serial Pred where
+  series = toSerial cPred
+  coseries = undefined
+
+-- deriveEnumerable ''TyVarBndr
+cTyVarBndr = 
+  [ c1 $ PlainTV
+  , c1 $ funcurry KindedTV
+  ]
+instance Enumerable TyVarBndr where
+  enumerate = toSel cTyVarBndr
+instance Serial TyVarBndr where
+  series = toSerial cTyVarBndr
+  coseries = undefined
+
+
+cKind = 
+  [c0 StarK
+  ,c1 (funcurry ArrowK)
+  ]
+instance Enumerable Kind where
+  enumerate = toSel cKind
+instance Serial Kind where
+  series = toSerial cKind
+  coseries = undefined
+
+
+cBody =
+  [ c1 NormalB
+  , c1 $ \(x) -> GuardedB (nonEmpty x)
+  -- Removed primitive litterals
+  ]
+instance Enumerable Body where
+ enumerate = toSel cBody
+instance Serial Body where
+  series = toSerial cBody
+  coseries = undefined
+
+cGuard = 
+  [c1 $ NormalG
+  ,c1 $ \(s) -> PatG (nonEmpty s)
+  ]
+instance Enumerable Guard where
+ enumerate = toSel cGuard
+instance Serial Guard where
+  series = toSerial cGuard
+  coseries = undefined
+  
+
+cCallconv = [c0 CCall, c0 StdCall]
+instance Enumerable Callconv where
+  enumerate = toSel cCallconv
+instance Serial Callconv where
+  series = toSerial cCallconv
+  coseries = undefined
+
+
+cSafety = [c0 Unsafe, c0 Safe, c0 Interruptible]
+instance Enumerable Safety where
+  enumerate = toSel cSafety
+instance Serial Safety where
+  series = toSerial cSafety
+  coseries = undefined
+  
+
+cStrict = [c0 IsStrict, c0 NotStrict, c0 Unpacked]
+instance Enumerable Strict where
+  enumerate = toSel cStrict
+instance Serial Strict where
+  series = toSerial cStrict
+  coseries = undefined
+
+cInlineSpec = [c1 (funcurry $ funcurry $ InlineSpec)]
+instance Enumerable InlineSpec where
+  enumerate = toSel cInlineSpec
+instance Serial InlineSpec where
+  series = toSerial cInlineSpec
+  coseries = undefined
+
+cOccName = 
+   [ c0 $ OccName "Con"
+   , c0 $ OccName "var"
+   ]
+instance Enumerable OccName where
+  enumerate = toSel cOccName
+instance Serial OccName where
+  series = toSerial cOccName
+  coseries = undefined
+
+cBindN = [c0 $ BindN $ Name (OccName "var") NameS]
+instance Enumerable BindN where
+  enumerate = toSel cBindN
+instance Serial BindN where
+  series = toSerial cBindN
+  coseries = undefined
+  
+cLcaseN = [c1 $ \nf -> LcaseN $ Name (OccName "var") nf]
+instance Enumerable LcaseN where
+  enumerate = toSel cLcaseN
+instance Serial LcaseN where
+  series = toSerial cLcaseN
+  coseries = undefined
+  
+cUpcaseName = [c1 $ \nf -> UpcaseName $ Name (OccName "Con") nf]
+instance Serial UpcaseName where
+  series = toSerial cUpcaseName
+  coseries = undefined
+instance Enumerable UpcaseName where
+  enumerate = toSel cUpcaseName
+  
+cModName = [c0 $ ModName "M", c0 $ ModName "C.M"]
+instance Enumerable ModName where
+  enumerate = toSel cModName
+instance Serial ModName where
+  series = toSerial cModName
+  coseries = undefined
+   
+
+cRange = 
+  [ c1 FromR
+  , c1 (funcurry FromThenR)
+  , c1 (funcurry FromToR)
+  , c1 (funcurry $ funcurry FromThenToR)
+  ]
+instance Enumerable Range where
+  enumerate = toSel cRange
+instance Serial Range where
+  series = toSerial cRange
+  coseries = undefined
+
+cNameFlavour = (
+  [ c1 NameQ
+--    , funcurry $ funcurry NameG 
+--    , \(I# x) -> NameU x
+--    , \(I# x) -> NameL x
+  , c0 NameS
+  ])
+instance Enumerable NameFlavour where
+  enumerate = toSel cNameFlavour
+instance Serial NameFlavour where
+  series = toSerial cNameFlavour
+  coseries = undefined
+
+-- instance (Enumerable a, Integral a) => Enumerable (Ratio a) where
+--   enumerate = consts [c1 $ funcurry (:%)]
+
+
diff --git a/testing-feat.cabal b/testing-feat.cabal
new file mode 100644
--- /dev/null
+++ b/testing-feat.cabal
@@ -0,0 +1,54 @@
+Name:                testing-feat
+Version:             0.1
+Synopsis:            Functional enumeration for systematic and random testing
+Description:         Feat (Functional Enumeration of Abstract Types) 
+                     provides an enumeration as a function from natural 
+                     numbers to values (similar to @toEnum@). This can be used
+                     both for SmallCheck-style systematic testing and QuickCheck 
+                     style random testing, and hybrids of the two.
+                     .
+                     The enumerators are defined in a very boilerplate manner
+                     and there is a Template Haskell script for deriving the 
+                     class instance for most types.
+                     "Test.Feat" contain a subset of the other modules that 
+                     should be sufficient for most test usage. There 
+                     is a large scale example in the tar ball (testing the 
+                     Template Haskell pretty printer).
+                                          
+License:             BSD3
+License-file:        LICENSE
+Author:              Jonas Duregård
+Maintainer:          jonas.duregard@gmail.com
+Copyright:           Jonas Duregård
+Category:            Testing
+Build-type:          Simple
+
+Extra-source-files:  
+    examples/TestTH.hs
+
+Cabal-version:       >=1.2
+
+Library
+  Hs-source-dirs:       .
+  Exposed-modules:
+    Test.Feat, 
+    Test.Feat.Access,
+    Test.Feat.Class,
+    Test.Feat.Enumerate,
+    Test.Feat.Modifiers 
+    Control.Monad.TagShare
+
+  
+  Build-depends: 
+    base >= 4.5 && <= 5,
+    template-haskell >= 2.4 && < 2.8,
+    mtl >= 1 && < 3,
+    QuickCheck > 2 && < 3,
+    containers < 1,
+    data-memocombinators >= 0.4.2 && < 0.5
+    
+  Other-modules:
+    Test.Feat.Internals.Derive
+    Test.Feat.Internals.Tag
+    
+