diff --git a/ad.cabal b/ad.cabal
--- a/ad.cabal
+++ b/ad.cabal
@@ -1,5 +1,5 @@
 name:         ad
-version:      4.0
+version:      4.0.0.1
 license:      BSD3
 license-File: LICENSE
 copyright:    (c) Edward Kmett 2010-2014,
@@ -22,6 +22,7 @@
   README.markdown
   travis/cabal-apt-install
   travis/config
+  include/instances.h
 synopsis:     Automatic Differentiation
 description:
     Forward-, reverse- and mixed- mode automatic differentiation combinators with a common API.
diff --git a/include/instances.h b/include/instances.h
new file mode 100644
--- /dev/null
+++ b/include/instances.h
@@ -0,0 +1,105 @@
+#ifndef BODY1
+#define BODY1(x) x
+#endif
+
+#ifndef BODY2
+#define BODY2(x,y) (x,y)
+#endif
+
+instance BODY2(Num a, Eq a) => Eq (HEAD) where
+  a == b = primal a == primal b
+
+instance BODY2(Num a, Ord a) => Ord (HEAD) where
+  compare a b = compare (primal a) (primal b)
+
+instance BODY2(Num a, Bounded a) => Bounded (HEAD) where
+  maxBound = auto maxBound
+  minBound = auto minBound
+
+instance BODY1(Num a) => Num (HEAD) where
+  fromInteger 0  = zero
+  fromInteger n = auto (fromInteger n)
+  (+)          = (<+>) -- binary (+) 1 1
+  (-)          = binary (-) (auto 1) (auto (-1)) -- TODO: <-> ? as it is, this might be pretty bad for Tower
+  (*)          = lift2 (*) (\x y -> (y, x))
+  negate       = lift1 negate (const (auto (-1)))
+  abs          = lift1 abs signum
+  signum a     = lift1 signum (const zero) a
+
+instance BODY1(Fractional a) => Fractional (HEAD) where
+  fromRational 0 = zero
+  fromRational r = auto (fromRational r)
+  x / y        = x * recip y
+  recip        = lift1_ recip (const . negate . join (*))
+
+instance BODY1(Floating a) => Floating (HEAD) where
+  pi       = auto pi
+  exp      = lift1_ exp const
+  log      = lift1 log recip
+  logBase x y = log y / log x
+  sqrt     = lift1_ sqrt (\z _ -> recip (auto 2 * z))
+  (**)     = (<**>)
+  --x ** y
+  --   | isKnownZero y     = 1
+  --   | isKnownConstant y, y' <- primal y = lift1 (** y') ((y'*) . (**(y'-1))) x
+  --   | otherwise         = lift2_ (**) (\z xi yi -> (yi * z / xi, z * log1 xi)) x y
+  sin      = lift1 sin cos
+  cos      = lift1 cos $ negate . sin
+  tan      = lift1 tan $ recip . join (*) . cos
+  asin     = lift1 asin $ \x -> recip (sqrt (auto 1 - join (*) x))
+  acos     = lift1 acos $ \x -> negate (recip (sqrt (1 - join (*) x)))
+  atan     = lift1 atan $ \x -> recip (1 + join (*) x)
+  sinh     = lift1 sinh cosh
+  cosh     = lift1 cosh sinh
+  tanh     = lift1 tanh $ recip . join (*) . cosh
+  asinh    = lift1 asinh $ \x -> recip (sqrt (1 + join (*) x))
+  acosh    = lift1 acosh $ \x -> recip (sqrt (join (*) x - 1))
+  atanh    = lift1 atanh $ \x -> recip (1 - join (*) x)
+
+instance BODY2(Num a, Enum a) => Enum (HEAD) where
+  succ             = lift1 succ (const 1)
+  pred             = lift1 pred (const 1)
+  toEnum           = auto . toEnum
+  fromEnum a       = fromEnum (primal a)
+  enumFrom a       = withPrimal a <$> enumFrom (primal a)
+  enumFromTo a b   = withPrimal a <$> enumFromTo (primal a) (primal b)
+  enumFromThen a b = zipWith (fromBy a delta) [0..] $ enumFromThen (primal a) (primal b) where delta = b - a
+  enumFromThenTo a b c = zipWith (fromBy a delta) [0..] $ enumFromThenTo (primal a) (primal b) (primal c) where delta = b - a
+
+instance BODY1(Real a) => Real (HEAD) where
+  toRational = toRational . primal
+
+instance BODY1(RealFloat a) => RealFloat (HEAD) where
+  floatRadix     = floatRadix . primal
+  floatDigits    = floatDigits . primal
+  floatRange    = floatRange . primal
+  decodeFloat    = decodeFloat . primal
+  encodeFloat m e = auto (encodeFloat m e)
+  isNaN          = isNaN . primal
+  isInfinite     = isInfinite . primal
+  isDenormalized = isDenormalized . primal
+  isNegativeZero = isNegativeZero . primal
+  isIEEE         = isIEEE . primal
+  exponent = exponent . primal
+  scaleFloat n = unary (scaleFloat n) (scaleFloat n 1)
+  significand x =  unary significand (scaleFloat (- floatDigits x) 1) x
+  atan2 = lift2 atan2 $ \vx vy -> let r = recip (join (*) vx + join (*) vy) in (vy * r, negate vx * r)
+
+instance BODY1(RealFrac a) => RealFrac (HEAD) where
+  properFraction a = (w, a `withPrimal` pb) where
+      pa = primal a
+      (w, pb) = properFraction pa
+  truncate = truncate . primal
+  round    = round . primal
+  ceiling  = ceiling . primal
+  floor    = floor . primal
+
+instance BODY1(Erf a) => Erf (HEAD) where
+  erf = lift1 erf $ \x -> (2 / sqrt pi) * exp (negate x * x)
+  erfc = lift1 erfc $ \x -> ((-2) / sqrt pi) * exp (negate x * x)
+  normcdf = lift1 normcdf $ \x -> ((-1) / sqrt pi) * exp (x * x * fromRational (- recip 2) / sqrt (2))
+
+instance BODY1(InvErf a) => InvErf (HEAD) where
+  inverf = lift1 inverfc $ \x -> recip $ (2 / sqrt pi) * exp (negate x * x)
+  inverfc = lift1 inverfc $ \x -> recip $ negate (2 / sqrt pi) * exp (negate x * x)
+  invnormcdf = lift1 invnormcdf $ \x -> recip $ ((-1) / sqrt pi) * exp (x * x * fromRational (- recip 2) / sqrt 2)