diff --git a/Numeric/AD/Classes.hs b/Numeric/AD/Classes.hs
--- a/Numeric/AD/Classes.hs
+++ b/Numeric/AD/Classes.hs
@@ -286,7 +286,8 @@
 -- > instance ('Lifted' $f, 'Num' a, 'Enum' a) => 'Enum' ($g a)
 -- > instance ('Lifted' $f, 'Num' a, 'Eq' a) => 'Eq' ($g a)
 -- > instance ('Lifted' $f, 'Num' a, 'Ord' a) => 'Ord' ($g a)
--- > instance ('Lifted' $f, 'Num a, 'Bounded' a) => 'Bounded' ($g a)
+-- > instance ('Lifted' $f, 'Num' a, 'Bounded' a) => 'Bounded' ($g a)
+--
 -- > instance ('Lifted' $f, 'Show' a) => 'Show' ($g a)
 -- > instance ('Lifted' $f, 'Num' a) => 'Num' ($g a)
 -- > instance ('Lifted' $f, 'Fractional' a) => 'Fractional' ($g a)
@@ -294,19 +295,19 @@
 -- > instance ('Lifted' $f, 'RealFloat' a) => 'RealFloat' ($g a)
 -- > instance ('Lifted' $f, 'RealFrac' a) => 'RealFrac' ($g a)
 -- > instance ('Lifted' $f, 'Real' a) => 'Real' ($g a)
-deriveNumeric :: Q Type -> Q Type -> Q [Dec]
-deriveNumeric t' t = do
+deriveNumeric :: ([Q Pred] -> [Q Pred]) -> Q Type -> Q [Dec]
+deriveNumeric f t = do
     members <- liftedMembers
     let keep n = nameBase n `elem` members
-    xs <- lowerInstance keep (classP ''Num [varA]:) t t' `mapM` [''Enum, ''Eq, ''Ord, ''Bounded]
-    ys <- lowerInstance keep id                     t t' `mapM` [''Show, ''Num, ''Fractional, ''Floating, ''RealFloat,''RealFrac, ''Real]
+    xs <- lowerInstance keep ((classP ''Num [varA]:) . f) t `mapM` [''Enum, ''Eq, ''Ord, ''Bounded]
+    ys <- lowerInstance keep f                            t `mapM` [''Show, ''Num, ''Fractional, ''Floating, ''RealFloat,''RealFrac, ''Real]
     return (xs ++ ys)
 
-lowerInstance :: (Name -> Bool) -> ([Q Pred] -> [Q Pred]) -> Q Type -> Q Type -> Name -> Q Dec
-lowerInstance p f t t' n = do
+lowerInstance :: (Name -> Bool) -> ([Q Pred] -> [Q Pred]) -> Q Type -> Name -> Q Dec
+lowerInstance p f t n = do
     ClassI (ClassD _ _ _ _ ds) <- reify n
-    instanceD (cxt (f [classP ''Lifted [t], classP n [varA]]))
-              (conT n `appT` (t' `appT` varA))
+    instanceD (cxt (f [classP n [varA]]))
+              (conT n `appT` (t `appT` varA))
               (concatMap lower1 ds)
     where
         lower1 :: Dec -> [Q Dec]
diff --git a/Numeric/AD/Forward.hs b/Numeric/AD/Forward.hs
--- a/Numeric/AD/Forward.hs
+++ b/Numeric/AD/Forward.hs
@@ -166,8 +166,13 @@
 
 -- | Compute the product of a vector with the Hessian using forward-on-forward-mode AD. 
 hessianProduct :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> f a
-hessianProduct f = duF (grad (decomposeMode . f . fmap composeMode))
+hessianProduct f = duF $ grad $ decomposeMode . f . fmap composeMode
 
 -- | Compute the gradient and hessian product using forward-on-forward-mode AD. 
 hessianProduct' :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f (a, a) -> f (a, a)
-hessianProduct' f = duF' (grad (decomposeMode . f . fmap composeMode))
+hessianProduct' f = duF' $ grad $ decomposeMode . f . fmap composeMode
+
+-- * Experimental
+
+-- data f :> a = a :< f (f :> a)
+-- gradients :: (Traversable f, Num a) => (forall s. Mode s => f (AD s a) -> AD s a) -> f a -> (f :> a)
diff --git a/Numeric/AD/Internal.hs b/Numeric/AD/Internal.hs
--- a/Numeric/AD/Internal.hs
+++ b/Numeric/AD/Internal.hs
@@ -12,6 +12,7 @@
 module Numeric.AD.Internal
     ( zipWithT
     , zipWithDefaultT
+    , on
     , AD(..)
     , Id(..)
     , probe
@@ -28,6 +29,9 @@
 import Data.Traversable (Traversable, mapAccumL)
 import Data.Foldable (Foldable, toList)
 
+on :: (a -> a -> b) -> (c -> a) -> c -> c -> b
+on f g a b = f (g a) (g b)
+
 data Pair a b = Pair a b deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable)
 
 zipWithT :: (Foldable f, Traversable g) => (a -> b -> c) -> f a -> g b -> g c
@@ -50,7 +54,13 @@
 -- interchangeably as both the type level \"brand\" and dictionary, providing a common API.
 newtype AD f a = AD { runAD :: f a } deriving (Iso (f a), Lifted, Mode, Primal)
 
-let f = varT (mkName "f") in deriveNumeric (conT ''AD `appT` f) f
+
+-- > instance (Lifted f, Num a) => Num (AD f a)
+-- etc.
+let f = varT (mkName "f") in 
+    deriveNumeric 
+        (classP ''Lifted [f]:) 
+        (conT ''AD `appT` f)
 
 newtype Id a = Id a deriving
     (Iso a, Eq, Ord, Show, Enum, Bounded, Num, Real, Fractional, Floating, RealFrac, RealFloat, Monoid)
diff --git a/Numeric/AD/Stream.hs b/Numeric/AD/Stream.hs
new file mode 100644
--- /dev/null
+++ b/Numeric/AD/Stream.hs
@@ -0,0 +1,144 @@
+{-# LANGUAGE TypeOperators, TemplateHaskell, ScopedTypeVariables #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Numeric.AD.Stream
+-- Copyright   :  (c) Edward Kmett 2010
+-- License     :  BSD3
+-- Maintainer  :  ekmett@gmail.com
+-- Stability   :  experimental
+-- Portability :  GHC only
+--
+-- A cofree comonad/f-branching stream  for use in returning towers of gradients. 
+--
+-----------------------------------------------------------------------------
+
+module Numeric.AD.Stream 
+    ( (:>)(..)
+    , Comonad(..)
+    , unfold
+    , tails
+    ) where
+
+import Control.Applicative
+import Data.Monoid
+import Data.Foldable
+import Data.Traversable
+import Numeric.AD.Classes
+import Numeric.AD.Internal
+import Language.Haskell.TH
+
+infixl 3 :<, :>
+
+class Functor f => Comonad f where
+    extract :: (f :> a) -> a
+    duplicate :: (f :> a) -> (f :> (f :> a))
+    extend :: ((f :> a) -> b) -> (f :> a) -> (f :> b)
+
+data (f :> a) = a :< f (f :> a)
+
+instance Functor f => Functor ((:>)f) where
+    fmap f (a :< as) = f a :< fmap f <$> as
+
+instance Functor f => Comonad ((:>) f) where
+    extract (a :< _) = a
+    duplicate aas@(_ :< as) = aas :< duplicate <$> as
+    extend f aas@(_ :< as) = f aas :< extend f <$> as
+
+instance Foldable f => Foldable ((:>) f) where
+    foldMap f (a :< as) = f a `mappend` foldMap (foldMap f) as
+
+instance Traversable f => Traversable ((:>) f) where
+    traverse f (a :< as) = (:<) <$> f a <*> traverse (traverse f) as
+
+-- tails of the f-branching stream comonad/cofree comonad
+tails :: (f :> a) -> f (f :> a)
+tails (_ :< as) = as
+
+unfold :: Functor f => (a -> (b, f a)) -> a -> (f :> b)
+unfold f a = h :< unfold f <$> t 
+    where
+        (h, t) = f a
+
+instance Primal ((:>) f) where
+    primal (a :< _) = a
+
+instance Mode f => Mode ((:>) 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 ((:>) 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 ((:>) f) ...
+deriveNumeric 
+    (classP (mkName "Mode") [varT $ mkName "f"]:) 
+    (conT (mkName ":>") `appT` varT (mkName "f")) 
diff --git a/ad.cabal b/ad.cabal
--- a/ad.cabal
+++ b/ad.cabal
@@ -1,9 +1,9 @@
 Name:         ad
-Version:      0.23
+Version:      0.24
 License:      BSD3
 License-File: LICENSE
-Copyright:    Edward Kmett 2010
-              Barak Pearlmutter and Jeffrey Mark Siskind 2008-2009
+Copyright:    (c) Edward Kmett 2010,
+              (c) Barak Pearlmutter and Jeffrey Mark Siskind 2008-2009
 Author:       Edward Kmett
 Maintainer:   ekmett@gmail.com
 Stability:    Experimental
@@ -32,6 +32,7 @@
     Numeric.AD.Directed
     Numeric.AD.Newton
     Numeric.AD.Classes
+    Numeric.AD.Stream
     Numeric.AD.Internal
     Numeric.AD.Internal.Composition
     Numeric.AD.Internal.Forward