diff --git a/Numeric/AD/Internal/Classes.hs b/Numeric/AD/Internal/Classes.hs
--- a/Numeric/AD/Internal/Classes.hs
+++ b/Numeric/AD/Internal/Classes.hs
@@ -179,9 +179,13 @@
 -- > instance Lifted $t => Jacobian $t where ...
 --
 -- The seemingly redundant @'Lifted' $t@ constraints are caused by Template Haskell staging restrictions.
-deriveLifted :: Q Type -> Q [Dec]
-deriveLifted _t = [d|
-    instance Lifted $_t where
+deriveLifted :: ([Q Pred] -> [Q Pred]) -> Q Type -> Q [Dec]
+deriveLifted f _t = do
+        [InstanceD cxt0 type0 dec0] <- lifted
+        return <$> instanceD (cxt (f (return <$> cxt0))) (return type0) (return <$> dec0)
+    where 
+      lifted = [d| 
+       instance Lifted $_t where
         (==!)         = (==) `on` primal
         compare1      = compare `on` primal
         maxBound1     = lift maxBound
@@ -247,8 +251,7 @@
         truncate1 = discrete1 truncate
         round1    = discrete1 round
         ceiling1  = discrete1 ceiling
-        floor1    = discrete1 floor
-    |]
+        floor1    = discrete1 floor |]
 
 varA :: Q Type
 varA = varT (mkName "a")
diff --git a/Numeric/AD/Internal/Dense.hs b/Numeric/AD/Internal/Dense.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/AD/Internal/Dense.hs
@@ -0,0 +1,155 @@
+{-# LANGUAGE Rank2Types, TypeFamilies, FlexibleContexts, UndecidableInstances, TemplateHaskell, DeriveDataTypeable, BangPatterns #-}
+-- {-# OPTIONS_HADDOCK hide, prune #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      : Numeric.AD.Internal.Dense
+-- Copyright   : (c) Edward Kmett 2010
+-- License     : BSD3
+-- Maintainer  : ekmett@gmail.com
+-- Stability   : experimental
+-- Portability : GHC only
+--
+-- Dense Forward AD. Useful when the result involves the majority of the input
+-- elements. Do not use for 'Numeric.AD.Mode.Mixed.hessian' and beyond, since
+-- they only contain a small number of unique @n@th derivatives --
+-- @(n + k - 1) `choose` k@ for functions of @k@ inputs rather than the
+-- @k^n@ that would be generated by using 'Dense', not to mention the redundant
+-- intermediate derivatives that would be
+-- calculated over and over during that process!
+--
+-- Assumes all instances of 'f' have the same number of elements.
+--
+-- NB: We don't need the full power of 'Traversable' here, we could get
+-- by with a notion of zippable that can plug in 0's for the missing
+-- entries. This might allow for gradients where @f@ has exponentials like @((->) a)@
+-----------------------------------------------------------------------------
+
+module Numeric.AD.Internal.Dense
+    ( Dense(..)
+    , ds
+    , ds'
+    , vars
+    , apply
+    ) where
+
+import Language.Haskell.TH
+import Data.Typeable ()
+import Data.Traversable (Traversable, mapAccumL)
+import Data.Data ()
+import Numeric.AD.Internal.Types
+import Numeric.AD.Internal.Combinators
+import Numeric.AD.Internal.Classes
+import Numeric.AD.Internal.Identity
+
+data Dense f a
+    = Lift a
+    | Dense a (f a)
+
+instance Show a => Show (Dense f a) where
+    showsPrec n (Lift a) = showsPrec n a
+    showsPrec n (Dense a _) = showsPrec n a
+
+ds :: f a -> AD (Dense f) a -> f a
+ds _    (AD (Dense _ da)) = da
+ds z _                = z
+{-# INLINE ds #-}
+
+ds' :: f a -> AD (Dense f) a -> (a, f a)
+ds' _    (AD (Dense a da)) = (a, da)
+ds' z (AD (Lift a))    = (a, z)
+{-# INLINE ds' #-}
+
+-- Bind variables and count inputs
+vars :: (Traversable f, Num a) => f a -> f (AD (Dense f) a)
+vars as = snd $ mapAccumL outer (0 :: Int) as
+    where
+        outer !i a = (i + 1, AD $ Dense a $ snd $ mapAccumL (inner i) 0 as)
+        inner !i !j _ = (j + 1, if i == j then 1 else 0)
+{-# INLINE vars #-}
+
+apply :: (Traversable f, Num a) => (f (AD (Dense f) a) -> b) -> f a -> b
+apply f as = f (vars as)
+{-# INLINE apply #-}
+
+instance Primal (Dense f) where
+    primal (Lift a) = a
+    primal (Dense a _) = a
+
+instance (Traversable f, Lifted (Dense f)) => Mode (Dense f) where
+    lift = Lift
+    Lift a <+> Lift b = Lift (a + b)
+    Lift a <+> Dense b db = Dense (a + b) db
+    Dense a da <+> Lift b = Dense (a + b) da
+    Dense a da <+> Dense b db = Dense (a + b) $ zipWithT (+) da db
+    a *^ Lift b    = Lift (a * b)
+    a *^ Dense b db = Dense (a * b) $ fmap (a*) db
+    Lift a    ^* b = Lift (a * b)
+    Dense a da ^* b = Dense (a * b) $ fmap (*b) da
+    Lift a    ^/ b = Lift (a / b)
+    Dense a da ^/ b = Dense (a / b) $ fmap (/b) da
+
+instance (Traversable f, Lifted (Dense f)) => Jacobian (Dense f) where
+    type D (Dense f) = Id
+    unary f _         (Lift b)    = Lift (f b)
+    unary f (Id dadb) (Dense b db) = Dense (f b) (fmap (dadb *) db)
+
+    lift1 f _  (Lift b)    = Lift (f b)
+    lift1 f df (Dense b db) = Dense (f b) (fmap (dadb *) db)
+        where
+            Id dadb = df (Id b)
+
+    lift1_ f _  (Lift b)     = Lift (f b)
+    lift1_ f df (Dense b db) = Dense a (fmap (dadb *) db)
+        where
+            a = f b
+            Id dadb = df (Id a) (Id b)
+
+    binary f _ _ (Lift b) (Lift c)
+        = Lift (f b c)
+    binary f _ (Id dadc) (Lift b) (Dense c dc)
+        = Dense (f b c) $ fmap (* dadc) dc
+    binary f (Id dadb) _ (Dense b db) (Lift c)
+        = Dense (f b c) $ fmap (dadb *) db
+    binary f (Id dadb) (Id dadc) (Dense b db) (Dense c dc)
+        = Dense (f b c) $ zipWithT productRule db dc
+        where
+            productRule dbi dci = dadb * dbi + dci * dadc
+
+    lift2 f _  (Lift b) (Lift c)
+        = Lift (f b c)
+    lift2 f df (Lift b) (Dense c dc)
+        = Dense (f b c) $ fmap (*dadc) dc
+        where
+            (_, Id dadc) = df (Id b) (Id c)
+    lift2 f df (Dense b db) (Lift c)
+        = Dense (f b c) $ fmap (dadb*) db
+        where
+            (Id dadb, _) = df (Id b) (Id c)
+    lift2 f df (Dense b db) (Dense c dc) = Dense (f b c) da
+        where
+            (Id dadb, Id dadc) = df (Id b) (Id c)
+            da = zipWithT productRule db dc
+            productRule dbi dci = dadb * dbi + dci * dadc
+
+    lift2_ f _  (Lift b) (Lift c) = Lift (f b c)
+    lift2_ f df (Lift b) (Dense c dc)
+        = Dense a $ fmap (*dadc) dc
+        where
+            a = (f b c)
+            (_, Id dadc) = df (Id a) (Id b) (Id c)
+    lift2_ f df (Dense b db) (Lift c)
+        = Dense a $ fmap (dadb*) db
+        where
+            a = (f b c)
+            (Id dadb, _) = df (Id a) (Id b) (Id c)
+    lift2_ f df (Dense b db) (Dense c dc)
+        = Dense a $ zipWithT productRule db dc
+        where
+            a = f b c
+            (Id dadb, Id dadc) = df (Id a) (Id b) (Id c)
+            productRule dbi dci = dadb * dbi + dci * dadc
+
+let f = varT (mkName "f") in
+    deriveLifted
+        (classP ''Traversable [f]:)
+        (conT ''Dense `appT` f)
diff --git a/Numeric/AD/Internal/Forward.hs b/Numeric/AD/Internal/Forward.hs
--- a/Numeric/AD/Internal/Forward.hs
+++ b/Numeric/AD/Internal/Forward.hs
@@ -90,7 +90,7 @@
             (Id dadb, Id dadc) = df (Id a) (Id b) (Id c)
             da = dadb * db + dc * dadc
 
-deriveLifted $ conT ''Forward
+deriveLifted id $ conT ''Forward
 
 bind :: (Traversable f, Num a) => (f (AD Forward a) -> b) -> f a -> f b
 bind f as = snd $ mapAccumL outer (0 :: Int) as
diff --git a/Numeric/AD/Internal/Iterated.hs b/Numeric/AD/Internal/Iterated.hs
deleted file mode 100644
--- a/Numeric/AD/Internal/Iterated.hs
+++ /dev/null
@@ -1,185 +0,0 @@
-{-# LANGUAGE BangPatterns, TemplateHaskell, ScopedTypeVariables, DeriveDataTypeable, FlexibleContexts, UndecidableInstances #-}
--- {-# OPTIONS_HADDOCK hide #-}
------------------------------------------------------------------------------
--- |
--- Module      :  Numeric.AD.Internal.Iterated
--- Copyright   :  (c) Edward Kmett 2010
--- License     :  BSD3
--- Maintainer  :  ekmett@gmail.com
--- Stability   :  experimental
--- Portability :  GHC only
---
------------------------------------------------------------------------------
-
-module Numeric.AD.Internal.Iterated
-    ( Iterated(..)
-    , tailI
-    , unfoldI
-    , bundle
-    , bind
-    ) where
-
-import Control.Applicative
-import Data.Monoid
-import Data.Foldable
-import Data.Traversable
-import Data.Data (Data(..), mkDataType, DataType, mkConstr, Constr, constrIndex, Fixity(Infix))
-import Data.Typeable (Typeable1(..), Typeable(..), TyCon, mkTyCon, mkTyConApp, typeOfDefault, gcast1)
-import Numeric.AD.Internal.Types
-import Numeric.AD.Internal.Classes
-import Numeric.AD.Internal.Comonad
-import Numeric.AD.Internal.Combinators (on)
--- import qualified Numeric.AD.Internal.Forward
-import Numeric.AD.Internal.Forward (Forward(..))
-import Language.Haskell.TH
-
-infixl 3 :|
-
-data Iterated f a = a :| f (Iterated f a)
-
-bundle :: Num a => a -> a -> AD (Iterated Forward) a
-bundle a b = AD (a :| Forward (lift a) (lift b))
-
-bind :: (Traversable f, Num a) => (f (AD (Iterated Forward) a) -> b) -> f a -> f b
-bind f as = snd $ mapAccumL outer (0 :: Int) as
-    where
-        outer !i _ = (i + 1, f $ snd $ mapAccumL (inner i) 0 as)
-        inner !i !j a = (j + 1, bundle a $ if i == j then 1 else 0)
-
-instance Functor f => Functor (Iterated f) where
-    fmap f (a :| as) = f a :| fmap f <$> as
-
-instance Functor f => Copointed (Iterated f) where
-    extract (a :| _) = a
-
-instance Functor f => Comonad (Iterated f) where
-    duplicate aas@(_ :| as) = aas :| duplicate <$> as
-    extend f aas@(_ :| as) = f aas :| extend f <$> as
-
-instance Foldable f => Foldable (Iterated f) where
-    foldMap f (a :| as) = f a `mappend` foldMap (foldMap f) as
-
-instance Traversable f => Traversable (Iterated f) where
-    traverse f (a :| as) = (:|) <$> f a <*> traverse (traverse f) as
-
--- tails of the f-branching stream comonad/cofree comonad
-tailI :: (Iterated f a) -> f (Iterated f a)
-tailI (_ :| as) = as
-
-unfoldI :: Functor f => (a -> (b, f a)) -> a -> Iterated f b
-unfoldI f a = h :| unfoldI f <$> t
-    where
-        (h, t) = f a
-
-instance Primal (Iterated f) where
-    primal (a :| _) = a
-
-instance Mode f => Mode (Iterated f) where
-    lift a = as
-        where as = a :| lift as
-    (a :| as) <+> (b :| bs) = (a + b) :| (as <+> bs)
-    a *^ (b :| bs) = (a * b) :| (lift a *^ bs)
-    (a :| as) ^* b = (a * b) :| (as ^* lift b)
-    (a :| as) ^/ b = (a / b) :| (as ^/ lift b)
-
-instance Mode f => Lifted (Iterated f) where
-    showsPrec1 n (a :| _) = showsPrec n a
-    (==!) = (==) `on` primal
-    compare1 = compare `on` primal
-    fromInteger1 a = fromInteger a :| fromInteger1 a
-    (a :| as) +! (b :| bs) = (a + b) :| (as +! bs)
-    (a :| as) -! (b :| bs) = (a - b) :| (as -! bs)
-    (a :| as) *! (b :| bs) = (a * b) :| (as *! bs)
-    negate1 (a :| as) = negate a :| negate1 as
-    abs1 (a :| as) = abs a :| abs1 as
-    signum1 (a :| as) = signum a :| signum1 as
-    (a :| as) /! (b :| bs) = (a / b) :| (as /! bs)
-    recip1 (a :| as) = recip a :| recip1 as
-    fromRational1 n = fromRational n :| fromRational1 n
-    toRational1 = toRational . primal
-    pi1 = pi :| pi1
-    exp1 (a :| as) = exp a :| exp1 as
-    log1 (a :| as) = log a :| log1 as
-    sqrt1 (a :| as) = sqrt a :| sqrt1 as
-    (a :| as) **! (b :| bs) = (a ** b) :| (as **! bs)
-    logBase1 (a :| as) (b :| bs) = logBase a b :| logBase1 as bs
-    sin1 (a :| as) = sin a :| sin1 as
-    cos1 (a :| as) = cos a :| cos1 as
-    tan1 (a :| as) = tan a :| tan1 as
-    asin1 (a :| as) = asin a :| asin1 as
-    acos1 (a :| as) = acos a :| acos1 as
-    atan1 (a :| as) = atan a :| atan1 as
-    sinh1 (a :| as) = sinh a :| sinh1 as
-    cosh1 (a :| as) = cosh a :| cosh1 as
-    tanh1 (a :| as) = tanh a :| tanh1 as
-    asinh1 (a :| as) = asinh a :| asinh1 as
-    acosh1 (a :| as) = acosh a :| acosh1 as
-    atanh1 (a :| as) = atanh a :| atanh1 as
-    properFraction1 (a :| as) = (b, c :| cs)
-        where
-            (b, c) = properFraction a
-            (_ :: Int, cs) = properFraction1 as
-    truncate1 = truncate . primal
-    round1 = round . primal
-    ceiling1 = ceiling . primal
-    floor1  = floor . primal
-    floatRadix1 = floatRadix . primal
-    floatDigits1 = floatDigits . primal
-    floatRange1 = floatRange . primal
-    decodeFloat1 = decodeFloat . primal
-    encodeFloat1 m e = encodeFloat m e :| encodeFloat1 m e
-    exponent1 = exponent . primal
-    significand1 (a :| as) = significand a :| significand1 as
-    scaleFloat1 n (a :| as) = scaleFloat n a :| scaleFloat1 n as
-    isNaN1 = isNaN . primal
-    isInfinite1 = isInfinite . primal
-    isDenormalized1 = isDenormalized . primal
-    isNegativeZero1 = isNegativeZero . primal
-    isIEEE1 = isIEEE . primal
-    atan21 (a :| as) (b :| bs) = atan2 a b :| atan21 as bs
-    succ1 (a :| as) = succ a :| succ1 as
-    pred1 (a :| as) = pred a :| pred1 as
-    toEnum1 n = toEnum n :| toEnum1 n
-    fromEnum1 = fromEnum . primal
-    enumFrom1 = error "TODO"
-    enumFromThen1 = error "TODO"
-    enumFromTo1 = error "TODO"
-    enumFromThenTo1 = error "TODO"
-    minBound1 = minBound :| minBound1
-    maxBound1 = maxBound :| maxBound1
-    -- TODO:
-
--- instance (Mode f, Foo a) => Foo (Iterated f) ...
-deriveNumeric
-    (classP (mkName "Mode") [varT $ mkName "f"]:)
-    (conT (mkName "Iterated") `appT` varT (mkName "f"))
-
-instance Typeable1 f => Typeable1 (Iterated f) where
-    typeOf1 tfa = mkTyConApp iteratedTyCon [typeOf1 (undefined `asArgsType` tfa)]
-        where asArgsType :: f a -> t f a -> f a
-              asArgsType = const
-
-instance (Typeable1 f, Typeable a) => Typeable (Iterated f a) where
-    typeOf = typeOfDefault
-    
-iteratedTyCon :: TyCon
-iteratedTyCon = mkTyCon "Numeric.AD.Internal.Iterated.Iterated"
-{-# NOINLINE iteratedTyCon #-}
-
-consConstr :: Constr
-consConstr = mkConstr iteratedDataType "(:|)" [] Infix
-{-# NOINLINE consConstr #-}
-
-iteratedDataType :: DataType
-iteratedDataType = mkDataType "Numeric.AD.Internal.Iterated.Iterated" [consConstr]
-{-# NOINLINE iteratedDataType #-}
-
-instance (Typeable1 f, Data (f (Iterated f a)), Data a) => Data (Iterated f a) where
-    gfoldl f z (a :| as) = z (:|) `f` a `f` as
-    toConstr _ = consConstr
-    gunfold k z c = case constrIndex c of
-        1 -> k (k (z (:|)))
-        _ -> error "gunfold"
-    dataTypeOf _ = iteratedDataType
-    dataCast1 f = gcast1 f
-
diff --git a/Numeric/AD/Internal/Reverse.hs b/Numeric/AD/Internal/Reverse.hs
--- a/Numeric/AD/Internal/Reverse.hs
+++ b/Numeric/AD/Internal/Reverse.hs
@@ -116,8 +116,7 @@
             a = f pb pc
             (dadb, dadc) = df (Id a) (Id pb) (Id pc)
 
-deriveLifted (conT ''Reverse)
--- deriveNumeric  ''Reverse
+deriveLifted id (conT ''Reverse)
 
 derivative :: Num a => AD Reverse a -> a
 derivative = sum . map snd . partials
diff --git a/Numeric/AD/Internal/Sparse.hs b/Numeric/AD/Internal/Sparse.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/AD/Internal/Sparse.hs
@@ -0,0 +1,136 @@
+{-# LANGUAGE BangPatterns, TemplateHaskell, TypeFamilies, TypeOperators, FlexibleContexts, UndecidableInstances, DeriveDataTypeable #-}
+module Numeric.AD.Internal.Sparse 
+    ( Index(..)
+    , emptyIndex
+    , addToIndex
+    , indices
+    , Sparse(..)
+    , vars
+    , d
+    , d'
+    , ds
+    , skeleton
+    , spartial
+    , partial
+    ) where
+
+import Prelude hiding (lookup)
+import Control.Applicative
+import Numeric.AD.Internal.Classes
+import Numeric.AD.Internal.Stream
+import Numeric.AD.Internal.Types
+import Data.Data
+import Data.Typeable ()
+import qualified Data.IntMap as IntMap 
+import Data.IntMap (IntMap, mapWithKey, unionWith, findWithDefault, toAscList, singleton, insertWith, lookup)
+import Data.Traversable
+import Language.Haskell.TH
+
+newtype Index = Index (IntMap Int)
+
+emptyIndex :: Index
+emptyIndex = Index IntMap.empty
+{-# INLINE emptyIndex #-}
+
+addToIndex :: Int -> Index -> Index
+addToIndex k (Index m) = Index (insertWith (+) k 1 m)
+{-# INLINE addToIndex #-}
+
+indices :: Index -> [Int]
+indices (Index as) = uncurry (flip replicate) `concatMap` toAscList as
+{-# INLINE indices #-}
+
+-- | We only store partials in sorted order, so the map contained in a partial
+-- will only contain partials with equal or greater keys to that of the map in
+-- which it was found. This should be key for efficiently computing sparse hessians.
+-- there are only (n + k - 1) choose k distinct nth partial derivatives of a 
+-- function with k inputs.
+data Sparse a = Sparse a (IntMap (Sparse a)) deriving (Show, Data, Typeable)
+
+-- | drop keys below a given value
+dropMap :: Int -> IntMap a -> IntMap a
+dropMap n = snd . IntMap.split (n - 1) 
+{-# INLINE dropMap #-}
+
+times :: Num a => Sparse a -> Int -> Sparse a -> Sparse a
+times (Sparse a as) n (Sparse b bs) = Sparse (a * b) $
+    unionWith (<+>) 
+        (fmap (^* b) (dropMap n as))
+        (fmap (a *^) (dropMap n bs))
+{-# INLINE times #-}
+
+vars :: (Traversable f, Num a) => f a -> f (AD Sparse a)
+vars = snd . mapAccumL var 0 
+    where
+        var !n a = (n + 1, AD $ Sparse a $ singleton n $ lift 1)
+{-# INLINE vars #-}
+
+skeleton :: Traversable f => f a -> f Int
+skeleton = snd . mapAccumL (\ !n _ -> (n + 1, n)) 0
+{-# INLINE skeleton #-}
+
+d :: (Traversable f, Num a) => f b -> AD Sparse a -> f a
+d fs (AD (Sparse _ da)) = snd $ mapAccumL (\ !n _ -> (n + 1, maybe 0 primal $ lookup n da)) 0 fs
+{-# INLINE d #-}
+
+d' :: (Traversable f, Num a) => f a -> AD Sparse a -> (a, f a)
+d' fs (AD (Sparse a da)) = (a , snd $ mapAccumL (\ !n _ -> (n + 1, maybe 0 primal $ lookup n da)) 0 fs)
+{-# INLINE d' #-}
+
+ds :: (Traversable f, Num a) => f b -> AD Sparse a -> Stream f a
+ds fs (AD as@(Sparse a _)) = a :< (go emptyIndex <$> fns)
+    where
+        fns = skeleton fs
+        -- go :: Index -> Int -> Stream f a
+        go ix i = partial (indices ix') as :< (go ix' <$> fns)
+            where ix' = addToIndex i ix
+{-# INLINE ds #-}
+
+partial :: Num a => [Int] -> Sparse a -> a
+partial []     (Sparse a _)  = a
+partial (n:ns) (Sparse _ da) = partial ns $ findWithDefault (lift 0) n da
+{-# INLINE partial #-}
+
+spartial :: Num a => [Int] -> Sparse a -> Maybe a
+spartial [] (Sparse a _) = Just a
+spartial (n:ns) (Sparse _ da) = do
+    a' <- lookup n da
+    spartial ns a'
+{-# INLINE spartial #-}
+
+instance Primal Sparse where
+    primal (Sparse a _) = a
+
+instance Lifted Sparse => Mode Sparse where
+    lift a = Sparse a (IntMap.empty)
+    Sparse a as <+> Sparse b bs = Sparse (a + b) $ unionWith (<+>) as bs
+    Sparse a as ^* b = Sparse (a * b) $ fmap (^* b) as
+    a *^ Sparse b bs = Sparse (a * b) $ fmap (a *^) bs
+    Sparse a as ^/ b = Sparse (a / b) $ fmap (^/ b) as
+
+instance Lifted Sparse => Jacobian Sparse where
+    type D Sparse = Sparse
+    unary f dadb (Sparse pb bs) = Sparse (f pb) $ mapWithKey (times dadb) bs
+    lift1 f df b@(Sparse pb bs) = Sparse (f pb) $ mapWithKey (times (df b)) bs
+    lift1_ f df b@(Sparse pb bs) = a where
+        a = Sparse (f pb) $ mapWithKey (times (df a b)) bs
+
+    binary f dadb dadc (Sparse pb db) (Sparse pc dc) = Sparse (f pb pc) $ 
+        unionWith (<+>) 
+            (mapWithKey (times dadb) db)
+            (mapWithKey (times dadc) dc)
+
+    lift2 f df b@(Sparse pb db) c@(Sparse pc dc) = Sparse (f pb pc) da where
+        (dadb, dadc) = df b c
+        da = unionWith (<+>) 
+            (mapWithKey (times dadb) db)
+            (mapWithKey (times dadc) dc)
+        
+    lift2_ f df b@(Sparse pb db) c@(Sparse pc dc) = a where
+        (dadb, dadc) = df a b c
+        a = Sparse (f pb pc) da
+        da = unionWith (<+>) 
+            (mapWithKey (times dadb) db)
+            (mapWithKey (times dadc) dc)
+
+deriveLifted id $ conT ''Sparse
diff --git a/Numeric/AD/Internal/Tensors.hs b/Numeric/AD/Internal/Tensors.hs
--- a/Numeric/AD/Internal/Tensors.hs
+++ b/Numeric/AD/Internal/Tensors.hs
@@ -28,8 +28,10 @@
 
 infixl 3 :-
 
+-- Polymorphic recursion precludes 'Data' in its current form, as no Data1 class exists
+-- Polymorphic recursion also breaks 'show' for 'Tensors'!
+-- factor Show1 out of Lifted?
 data Tensors f a = a :- Tensors f (f a)
--- Polymorphic recursion precludes Data in its current form, as no Data1 class exists
 
 instance Functor f => Functor (Tensors f) where
     fmap f (a :- as) = f a :- fmap (fmap f) as
diff --git a/Numeric/AD/Internal/Tower.hs b/Numeric/AD/Internal/Tower.hs
--- a/Numeric/AD/Internal/Tower.hs
+++ b/Numeric/AD/Internal/Tower.hs
@@ -133,4 +133,4 @@
         a = bundle a0 da
         (dadb, dadc) = df a b c
 
-deriveLifted (conT ''Tower)
+deriveLifted id (conT ''Tower)
diff --git a/Numeric/AD/Mode/Mixed.hs b/Numeric/AD/Mode/Mixed.hs
--- a/Numeric/AD/Mode/Mixed.hs
+++ b/Numeric/AD/Mode/Mixed.hs
@@ -53,6 +53,9 @@
     , hessianProduct
     , hessianProduct'
 
+    -- * Higher Order Gradients/Hessians (Sparse Forward)
+    , gradients
+
     -- * Derivatives (Forward Mode)
     , diff
     , diffF
@@ -92,8 +95,7 @@
     , diffM'
 
     -- * Exposed Types
-    , UU, UF, FU, FF
-    , AD(..)
+    , module Numeric.AD.Types
     , Mode(..)
     ) where
 
@@ -101,7 +103,7 @@
 import Data.Foldable (Foldable, foldr')
 import Control.Applicative
 
-import Numeric.AD.Types (AD(..), UU, UF, FU, FF)
+import Numeric.AD.Types
 import Numeric.AD.Internal.Identity (probed, unprobe)
 import Numeric.AD.Internal.Composition
 import Numeric.AD.Classes (Mode(..))
@@ -127,6 +129,9 @@
     , gradF, gradF', gradWithF, gradWithF'
     )
 
+-- temporary until we make a full sparse mode
+import qualified Numeric.AD.Internal.Sparse as Sparse
+
 -- | Calculate the Jacobian of a non-scalar-to-non-scalar function, automatically choosing between forward and reverse mode AD based on the number of inputs and outputs.
 --
 -- If you need to support functions where the output is only a 'Functor' or 'Monad', consider 'Numeric.AD.Reverse.jacobian' or 'Numeric.AD.Reverse.gradM' from "Numeric.AD.Reverse".
@@ -213,3 +218,7 @@
     dda = Forward.jacobian (grad (decomposeMode . f . fmap composeMode)
     ddda = Forward
 -}
+
+gradients :: (Traversable f, Num a) => FU f a -> f a -> Stream f a
+gradients f as = Sparse.ds as $ f $ Sparse.vars as
+    
diff --git a/ad.cabal b/ad.cabal
--- a/ad.cabal
+++ b/ad.cabal
@@ -1,5 +1,5 @@
 name:         ad
-version:      0.33.0
+version:      0.40
 license:      BSD3
 license-File: LICENSE
 copyright:    (c) Edward Kmett 2010,
@@ -34,22 +34,24 @@
     Numeric.AD.Types
     Numeric.AD.Newton
 
-    Numeric.AD.Mode.Mixed
-    Numeric.AD.Mode.Forward
-    Numeric.AD.Mode.Reverse
-    Numeric.AD.Mode.Tower
-    Numeric.AD.Mode.Directed
-
     Numeric.AD.Internal.Classes
     Numeric.AD.Internal.Combinators
 
-    Numeric.AD.Internal.Composition
     Numeric.AD.Internal.Forward
-    Numeric.AD.Internal.Reverse
     Numeric.AD.Internal.Tower
+    Numeric.AD.Internal.Reverse
+    Numeric.AD.Internal.Sparse
+    Numeric.AD.Internal.Dense
+    Numeric.AD.Internal.Composition
     Numeric.AD.Internal.Identity
-    Numeric.AD.Internal.Iterated
 
+    Numeric.AD.Mode.Directed
+    Numeric.AD.Mode.Forward
+    Numeric.AD.Mode.Mixed
+    Numeric.AD.Mode.Reverse
+    Numeric.AD.Mode.Tower
+
+
 other-modules:
     Numeric.AD.Internal.Types
     Numeric.AD.Internal.Comonad
@@ -57,5 +59,4 @@
     Numeric.AD.Internal.Tensors
 
 Extra-Source-Files: TODO
-GHC-Options: -Wall -fspec-constr 
---           -O2
+GHC-Options: -Wall -fspec-constr -fdicts-cheap -O2