diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,8 +1,16 @@
+1.1.1
+-----
+* Fixed an infinite loop in the default definition of `liftI2`.
+
+1.1
+---
+* Added `Additive` instances for `[]`, `Maybe` and `Vector`.
+
 1.0
 ---
 * Strict vectors
 * Exported `mkTransformationMat`
-* Bumped dependency bounds.
+* Bumped dependency bounds
 
 0.9.1 [bug fix]
 -----
diff --git a/linear.cabal b/linear.cabal
--- a/linear.cabal
+++ b/linear.cabal
@@ -1,6 +1,6 @@
 name:          linear
 category:      Math, Algebra
-version:       1.0.1
+version:       1.1.1
 license:       BSD3
 cabal-version: >= 1.8
 license-file:  LICENSE
@@ -33,11 +33,16 @@
     base                 >= 4.5   && < 5,
     containers           >= 0.4   && < 0.6,
     distributive         >= 0.2.2 && < 1,
+    ghc-prim,
     hashable             >= 1.1   && < 1.3,
+    reflection           >= 1.1.6 && < 2,
     semigroups           >= 0.9   && < 1,
     semigroupoids        >= 3     && < 4,
+    tagged               >= 0.4.4 && < 1,
+    template-haskell     >= 2.7   && < 3.0,
     transformers         >= 0.2   && < 0.4,
-    unordered-containers >= 0.2.3 && < 0.3
+    unordered-containers >= 0.2.3 && < 0.3,
+    vector               >= 0.10  && < 0.11
 
   exposed-modules:
     Linear
@@ -49,6 +54,7 @@
     Linear.Metric
     Linear.Plucker
     Linear.Quaternion
+    Linear.V
     Linear.V0
     Linear.V2
     Linear.V3
diff --git a/src/Linear/Matrix.hs b/src/Linear/Matrix.hs
--- a/src/Linear/Matrix.hs
+++ b/src/Linear/Matrix.hs
@@ -15,7 +15,7 @@
   , adjoint
   , M22, M33, M44, M43, m33_to_m44, m43_to_m44
   , det22, det33, inv22, inv33
-  , eye3, eye4
+  , eye2, eye3, eye4
   , trace
   , translation
   , fromQuaternion
@@ -27,14 +27,13 @@
 import Control.Monad (join)
 import Data.Distributive
 import Data.Foldable as Foldable
-import Data.Functor.Apply
 import Linear.Epsilon
 import Linear.Metric
 import Linear.Quaternion
 import Linear.V2
 import Linear.V3
 import Linear.V4
-import Linear.Vector ((*^), Additive, liftU2, (^+^), (^-^))
+import Linear.Vector
 import Linear.Conjugate
 
 -- $setup
@@ -50,9 +49,8 @@
 --
 -- >>> V2 (fromList [(1,2)]) (fromList [(2,3)]) !*! fromList [(1,V3 0 0 1), (2, V3 0 0 5)]
 -- V2 (V3 0 0 2) (V3 0 0 15)
-(!*!) :: (Functor m, Foldable r, Apply r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)
-f !*! g = fmap (\r -> Foldable.sum . liftF2 (*) r <$> g') f
-  where g' = distribute g
+(!*!) :: (Functor m, Foldable r, Additive r, Distributive n, Num a) => m (r a) -> r (n a) -> m (n a)
+f !*! g = fmap (\r -> Foldable.sum . liftI2 (*) r <$> g') f where g' = distribute g
 
 infixl 6 !+!
 -- | Entry-wise matrix addition.
@@ -173,6 +171,14 @@
 m33_to_m44 (V3 r1 r2 r3) = V4 (vector r1) (vector r2) (vector r3) (point 0)
 {-# ANN m33_to_m44 "HLint: ignore Use camelCase" #-}
 
+-- |2x2 identity matrix.
+--
+-- >>> eye2
+-- V2 (V2 1 0) (V2 0 1)
+eye2 :: Num a => M22 a
+eye2 = V2 (V2 1 0)
+          (V2 0 1)
+
 -- |3x3 identity matrix.
 --
 -- >>> eye3
@@ -191,7 +197,6 @@
           (V4 0 1 0 0)
           (V4 0 0 1 0)
           (V4 0 0 0 1)
-
 
 -- |Extract the translation vector (first three entries of the last
 -- column) from a 3x4 or 4x4 matrix
diff --git a/src/Linear/Metric.hs b/src/Linear/Metric.hs
--- a/src/Linear/Metric.hs
+++ b/src/Linear/Metric.hs
@@ -17,7 +17,7 @@
   ) where
 
 import Data.Foldable as Foldable
-import Data.Functor.Apply
+import Data.Functor.Identity
 import Linear.Epsilon
 import Linear.Vector
 
@@ -34,7 +34,7 @@
   dot :: Num a => f a -> f a -> a
 #ifndef HLINT
   default dot :: (Foldable f, Num a) => f a -> f a -> a
-  dot x y = Foldable.sum $ liftF2 (*) x y
+  dot x y = Foldable.sum $ liftI2 (*) x y
 #endif
 
   -- | Compute the squared norm. The name quadrance arises from
@@ -58,6 +58,9 @@
   signorm :: Floating a => f a -> f a
   signorm v = fmap (/m) v where
     m = norm v
+
+instance Metric Identity where
+  dot (Identity x) (Identity y) = x * y
 
 -- | Normalize a 'Metric' functor to have unit 'norm'. This function
 -- does not change the functor if its 'norm' is 0 or 1.
diff --git a/src/Linear/Plucker.hs b/src/Linear/Plucker.hs
--- a/src/Linear/Plucker.hs
+++ b/src/Linear/Plucker.hs
@@ -63,7 +63,13 @@
     Plucker (a g) (b h) (c i) (d j) (e k) (f l)
   {-# INLINE (<*>) #-}
 
-instance Additive Plucker
+instance Additive Plucker where
+  zero = pure 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
 instance Bind Plucker where
   Plucker a b c d e f >>- g = Plucker a' b' c' d' e' f' where
diff --git a/src/Linear/Quaternion.hs b/src/Linear/Quaternion.hs
--- a/src/Linear/Quaternion.hs
+++ b/src/Linear/Quaternion.hs
@@ -70,7 +70,13 @@
   Quaternion f fv <*> Quaternion a v = Quaternion (f a) (fv <*> v)
   {-# INLINE (<*>) #-}
 
-instance Additive Quaternion
+instance Additive Quaternion where
+  zero = pure 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
 instance Bind Quaternion where
   Quaternion a (V3 b c d) >>- f = Quaternion a' (V3 b' c' d') where
diff --git a/src/Linear/V.hs b/src/Linear/V.hs
new file mode 100644
--- /dev/null
+++ b/src/Linear/V.hs
@@ -0,0 +1,230 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DataKinds, KindSignatures, ScopedTypeVariables, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE EmptyDataDecls #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances, UndecidableInstances #-}
+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 706
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+#define USE_TYPE_LITS 1
+#endif
+
+module Linear.V
+  ( V(toVector)
+  , int
+  , dim
+  , Dim(..)
+  , reifyDim
+  , reifyVector
+  , fromVector
+  ) where
+
+import Control.Applicative
+import Data.Distributive
+import Data.Foldable as Foldable
+import Data.Functor.Bind
+import Data.Proxy
+import Data.Reflection as R
+import Data.Traversable
+import Data.Vector as V
+import Foreign.Ptr
+import Foreign.Storable
+#ifdef USE_TYPE_LITS
+import GHC.TypeLits
+#endif
+import Language.Haskell.TH
+import Linear.Core
+import Linear.Epsilon
+import Linear.Metric
+import Linear.Vector
+
+class Dim n where
+  reflectDim :: p n -> Int
+
+newtype V n a = V { toVector :: V.Vector a } deriving (Eq,Ord,Show,Read)
+
+dim :: forall n a. Dim n => V n a -> Int
+dim _ = reflectDim (Proxy :: Proxy n)
+{-# INLINE dim #-}
+
+#ifdef USE_TYPE_LITS
+instance SingRep n Integer => Dim (n :: Nat) where
+  reflectDim _ = fromInteger $ withSing $ \(x :: Sing n) -> fromSing x
+  {-# INLINE reflectDim #-}
+#endif
+
+data ReifiedDim (s :: *)
+
+retagDim :: (Proxy s -> a) -> proxy (ReifiedDim s) -> a
+retagDim f _ = f Proxy
+{-# INLINE retagDim #-}
+
+instance Reifies s Int => Dim (ReifiedDim s) where
+  reflectDim = retagDim reflect
+  {-# INLINE reflectDim #-}
+
+reifyDim :: Int -> (forall (n :: *). Dim n => Proxy n -> r) -> r
+reifyDim i f = R.reify i (go f) where
+  go :: Reifies n Int => (Proxy (ReifiedDim n) -> a) -> proxy n -> a
+  go g _ = g Proxy
+{-# INLINE reifyDim #-}
+
+reifyVector :: forall a r. Vector a -> (forall (n :: *). Dim n => V n a -> r) -> r
+reifyVector v f = reifyDim (V.length v) $ \(Proxy :: Proxy n) -> f (V v :: V n a)
+{-# INLINE reifyVector #-}
+
+instance Dim n => Dim (V n a) where
+  reflectDim _ = reflectDim (Proxy :: Proxy n)
+  {-# INLINE reflectDim #-}
+
+instance Functor (V n) where
+  fmap f (V as) = V (fmap f as)
+  {-# INLINE fmap #-}
+
+instance Foldable (V n) where
+  foldMap f (V as) = foldMap f as
+  {-# INLINE foldMap #-}
+
+instance Traversable (V n) where
+  traverse f (V as) = V <$> traverse f as
+  {-# INLINE traverse #-}
+
+instance Apply (V n) where
+  V as <.> V bs = V (V.zipWith id as bs)
+  {-# INLINE (<.>) #-}
+
+instance Dim n => Applicative (V n) where
+  pure = V . V.replicate (reflectDim (Proxy :: Proxy n))
+  {-# INLINE pure #-}
+
+  V as <*> V bs = V (V.zipWith id as bs)
+  {-# INLINE (<*>) #-}
+
+instance Bind (V n) where
+  V as >>- f = V $ generate (V.length as) $ \i ->
+    toVector (f (as `unsafeIndex` i)) `unsafeIndex` i
+  {-# INLINE (>>-) #-}
+
+instance Dim n => Monad (V n) where
+  return = V . V.replicate (reflectDim (Proxy :: Proxy n))
+  {-# INLINE return #-}
+  V as >>= f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i ->
+    toVector (f (as `unsafeIndex` i)) `unsafeIndex` i
+  {-# INLINE (>>=) #-}
+
+instance Dim n => Additive (V n) where
+  zero = pure 0
+  {-# INLINE zero #-}
+  liftU2 f (V as) (V bs) = V (V.zipWith f as bs)
+  {-# INLINE liftU2 #-}
+  liftI2 f (V as) (V bs) = V (V.zipWith f as bs)
+  {-# INLINE liftI2 #-}
+
+instance (Dim n, Num a) => Num (V n a) where
+  V as + V bs = V $ V.zipWith (+) as bs
+  {-# INLINE (+) #-}
+  V as - V bs = V $ V.zipWith (-) as bs
+  {-# INLINE (-) #-}
+  V as * V bs = V $ V.zipWith (*) as bs
+  {-# INLINE (*) #-}
+  negate = fmap negate
+  {-# INLINE negate #-}
+  abs = fmap abs
+  {-# INLINE abs #-}
+  signum = fmap signum
+  {-# INLINE signum #-}
+  fromInteger = pure . fromInteger
+  {-# INLINE fromInteger #-}
+
+instance (Dim n, Fractional a) => Fractional (V n a) where
+  recip = fmap recip
+  {-# INLINE recip #-}
+  V as / V bs = V $ V.zipWith (/) as bs
+  {-# INLINE (/) #-}
+  fromRational = pure . fromRational
+  {-# INLINE fromRational #-}
+
+instance Dim n => Core (V n) where
+  core f = V $ generate (reflectDim (Proxy :: Proxy n)) $ \i -> f $ \g (V v) ->
+    (\a -> V $ v V.// [(i,a)]) <$> g (unsafeIndex v i)
+  {-# INLINE core #-}
+
+instance Dim n => Distributive (V n) where
+  distribute f = V $ V.generate (reflectDim (Proxy :: Proxy n)) $ \i -> fmap (\(V v) -> unsafeIndex v i) f
+  {-# INLINE distribute #-}
+
+instance (Dim n, Storable a) => Storable (V n a) where
+  sizeOf _ = reflectDim (Proxy :: Proxy n) * sizeOf (undefined:: a)
+  {-# INLINE sizeOf #-}
+  alignment _ = alignment (undefined :: a)
+  {-# INLINE alignment #-}
+  poke ptr (V xs) = Foldable.forM_ [0..reflectDim (Proxy :: Proxy n)-1] $ \i ->
+    pokeElemOff ptr' i (unsafeIndex xs i)
+    where ptr' = castPtr ptr
+  {-# INLINE poke #-}
+  peek ptr = V <$> generateM (reflectDim (Proxy :: Proxy n)) (peekElemOff ptr')
+    where ptr' = castPtr ptr
+  {-# INLINE peek #-}
+
+instance (Dim n, Epsilon a) => Epsilon (V n a) where
+  nearZero = nearZero . quadrance
+  {-# INLINE nearZero #-}
+
+instance Dim n => Metric (V n) where
+  dot (V a) (V b) = V.sum $ V.zipWith (*) a b
+  {-# INLINE dot #-}
+
+-- TODO: instance (Dim n, Ix a) => Ix (V n a)
+
+fromVector :: forall n a. Dim n => Vector a -> Maybe (V n a)
+fromVector v
+  | V.length v == reflectDim (Proxy :: Proxy n) = Just (V v)
+  | otherwise                                   = Nothing
+
+data Z  -- 0
+data D  (n :: *) -- 2n
+data SD (n :: *) -- 2n+1
+data PD (n :: *) -- 2n-1
+
+instance Reifies Z Int where
+  reflect _ = 0
+  {-# INLINE reflect #-}
+
+retagD :: (Proxy n -> a) -> proxy (D n) -> a
+retagD f _ = f Proxy
+{-# INLINE retagD #-}
+
+retagSD :: (Proxy n -> a) -> proxy (SD n) -> a
+retagSD f _ = f Proxy
+{-# INLINE retagSD #-}
+
+retagPD :: (Proxy n -> a) -> proxy (PD n) -> a
+retagPD f _ = f Proxy
+{-# INLINE retagPD #-}
+
+instance Reifies n Int => Reifies (D n) Int where
+  reflect = (\n -> n+n) <$> retagD reflect
+  {-# INLINE reflect #-}
+
+instance Reifies n Int => Reifies (SD n) Int where
+  reflect = (\n -> n+n+1) <$> retagSD reflect
+  {-# INLINE reflect #-}
+
+instance Reifies n Int => Reifies (PD n) Int where
+  reflect = (\n -> n+n-1) <$> retagPD reflect
+  {-# INLINE reflect #-}
+
+-- | This can be used to generate a template haskell splice for a type level version of a given 'int'.
+--
+-- This does not use GHC TypeLits, instead it generates a numeric type by hand similar to the ones used
+-- in the \"Functional Pearl: Implicit Dimurations\" paper by Oleg Kiselyov and Chung-Chieh Shan.
+int :: Int -> TypeQ
+int n = case quotRem n 2 of
+  (0, 0) -> conT ''Z
+  (q,-1) -> conT ''PD `appT` int q
+  (q, 0) -> conT ''D  `appT` int q
+  (q, 1) -> conT ''SD `appT` int q
+  _     -> error "ghc is bad at math"
+
+
diff --git a/src/Linear/V0.hs b/src/Linear/V0.hs
--- a/src/Linear/V0.hs
+++ b/src/Linear/V0.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveGeneric #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Linear.V0
@@ -25,6 +26,7 @@
 import Data.Traversable
 import Data.Semigroup
 import Data.Functor.Bind
+import GHC.Generics
 import Foreign.Storable (Storable(..))
 import Linear.Core
 import Linear.Metric
@@ -43,7 +45,7 @@
 -- >>> V0 + V0
 -- V0
 --
-data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable)
+data V0 a = V0 deriving (Eq,Ord,Show,Read,Ix,Enum,Data,Typeable,Generic)
 
 instance Functor V0 where
   fmap _ V0 = V0
@@ -67,9 +69,15 @@
   pure _ = V0
   {-# INLINE pure #-}
   V0 <*> V0 = V0
-  {-@ INLINE (<*>) #-}
+  {-# INLINE (<*>) #-}
 
-instance Additive V0
+instance Additive V0 where
+  zero = V0
+  {-# INLINE zero #-}
+  liftU2 _ V0 V0 = V0
+  {-# INLINE liftU2 #-}
+  liftI2 _ V0 V0 = V0
+  {-# INLINE liftI2 #-}
 
 instance Bind V0 where
   V0 >>- _ = V0
diff --git a/src/Linear/V2.hs b/src/Linear/V2.hs
--- a/src/Linear/V2.hs
+++ b/src/Linear/V2.hs
@@ -89,7 +89,13 @@
   V2 a b <*> V2 d e = V2 (a d) (b e)
   {-@ INLINE (<*>) #-}
 
-instance Additive V2
+instance Additive V2 where
+  zero = pure 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
 instance Bind V2 where
   V2 a b >>- f = V2 a' b' where
diff --git a/src/Linear/V3.hs b/src/Linear/V3.hs
--- a/src/Linear/V3.hs
+++ b/src/Linear/V3.hs
@@ -73,7 +73,13 @@
   V3 a b c <*> V3 d e f = V3 (a d) (b e) (c f)
   {-# INLINE (<*>) #-}
 
-instance Additive V3
+instance Additive V3 where
+  zero = pure 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
 instance Bind V3 where
   V3 a b c >>- f = V3 a' b' c' where
diff --git a/src/Linear/V4.hs b/src/Linear/V4.hs
--- a/src/Linear/V4.hs
+++ b/src/Linear/V4.hs
@@ -75,7 +75,13 @@
   V4 a b c d <.> V4 e f g h = V4 (a e) (b f) (c g) (d h)
   {-# INLINE (<.>) #-}
 
-instance Additive V4
+instance Additive V4 where
+  zero = pure 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
 instance Bind V4 where
   V4 a b c d >>- f = V4 a' b' c' d' where
diff --git a/src/Linear/Vector.hs b/src/Linear/Vector.hs
--- a/src/Linear/Vector.hs
+++ b/src/Linear/Vector.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE CPP #-}
 {-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Linear.Vector
@@ -19,19 +22,22 @@
   , (^/)
   , basis
   , basisFor
+  , kronecker
   ) where
 
 import Control.Applicative
 import Data.Complex
-import Data.Foldable (foldMap)
-import Data.Functor.Bind
+import Data.Foldable as Foldable (foldMap, forM_)
 import Data.Functor.Identity
 import Data.HashMap.Lazy as HashMap
 import Data.Hashable
 import Data.IntMap as IntMap
 import Data.Map as Map
-import Data.Monoid (Sum(..))
+import Data.Monoid (Sum(..), mempty)
+import Data.Vector as Vector
+import Data.Vector.Mutable as Mutable
 import Data.Traversable (Traversable, mapAccumL)
+import GHC.Generics
 import Linear.Instances ()
 
 -- $setup
@@ -41,13 +47,58 @@
 infixl 6 ^+^, ^-^
 infixl 7 ^*, *^, ^/
 
+class GAdditive f where
+  gzero :: Num a => f a
+  gliftU2 :: (a -> a -> a) -> f a -> f a -> f a
+  gliftI2 :: (a -> b -> c) -> f a -> f b -> f c
+
+instance GAdditive U1 where
+  gzero = U1
+  {-# INLINE gzero #-}
+  gliftU2 _ U1 U1 = U1
+  {-# INLINE gliftU2 #-}
+  gliftI2 _ U1 U1 = U1
+  {-# INLINE gliftI2 #-}
+
+instance (GAdditive f, GAdditive g) => GAdditive (f :*: g) where
+  gzero = gzero :*: gzero
+  {-# INLINE gzero #-}
+  gliftU2 f (a :*: b) (c :*: d) = gliftU2 f a c :*: gliftU2 f b d
+  {-# INLINE gliftU2 #-}
+  gliftI2 f (a :*: b) (c :*: d) = gliftI2 f a c :*: gliftI2 f b d
+  {-# INLINE gliftI2 #-}
+
+instance Additive f => GAdditive (Rec1 f) where
+  gzero = Rec1 zero
+  {-# INLINE gzero #-}
+  gliftU2 f (Rec1 g) (Rec1 h) = Rec1 (liftU2 f g h)
+  {-# INLINE gliftU2 #-}
+  gliftI2 f (Rec1 g) (Rec1 h) = Rec1 (liftI2 f g h)
+  {-# INLINE gliftI2 #-}
+
+instance GAdditive f => GAdditive (M1 i c f) where
+  gzero = M1 gzero
+  {-# INLINE gzero #-}
+  gliftU2 f (M1 g) (M1 h) = M1 (gliftU2 f g h)
+  {-# INLINE gliftU2 #-}
+  gliftI2 f (M1 g) (M1 h) = M1 (gliftI2 f g h)
+  {-# INLINE gliftI2 #-}
+
+instance GAdditive Par1 where
+  gzero = Par1 0
+  gliftU2 f (Par1 a) (Par1 b) = Par1 (f a b)
+  {-# INLINE gliftU2 #-}
+  gliftI2 f (Par1 a) (Par1 b) = Par1 (f a b)
+  {-# INLINE gliftI2 #-}
+
+
 -- | A vector is an additive group with additional structure.
-class Bind f => Additive f where
+class Functor f => Additive f where
   -- | The zero vector
   zero :: Num a => f a
 #ifndef HLINT
-  default zero :: (Applicative f, Num a) => f a
-  zero = pure 0
+  default zero :: (GAdditive (Rep1 f), Generic1 f, Num a) => f a
+  zero = to1 gzero
 #endif
 
   -- | Compute the sum of two vectors
@@ -56,7 +107,7 @@
   -- V2 4 6
   (^+^) :: Num a => f a -> f a -> f a
 #ifndef HLINT
-  default (^+^) :: (Num a) => f a -> f a -> f a
+  default (^+^) :: Num a => f a -> f a -> f a
   (^+^) = liftU2 (+)
   {-# INLINE (^+^) #-}
 #endif
@@ -67,7 +118,7 @@
   -- V2 1 4
   (^-^) :: Num a => f a -> f a -> f a
 #ifndef HLINT
-  default (^-^) :: (Num a) => f a -> f a -> f a
+  default (^-^) :: Num a => f a -> f a -> f a
   x ^-^ y = x ^+^ negated y
   {-# INLINE (^-^) #-}
 #endif
@@ -77,35 +128,122 @@
   lerp alpha u v = alpha *^ u ^+^ (1 - alpha) *^ v
   {-# INLINE lerp #-}
 
-  -- | Apply a function to merge the 'non-zero' components of two vectors.
+  -- | Apply a function to merge the 'non-zero' components of two vectors, unioning the rest of the values.
   --
   -- * For a dense vector this is equivalent to 'liftA2'.
   --
   -- * For a sparse vector this is equivalent to 'unionWith'.
   liftU2 :: (a -> a -> a) -> f a -> f a -> f a
 #ifndef HLINT
-  default liftU2 :: (Applicative f) => (a -> a -> a) -> f a -> f a -> f a
+  default liftU2 :: Applicative f => (a -> a -> a) -> f a -> f a -> f a
   liftU2 = liftA2
   {-# INLINE liftU2 #-}
 #endif
 
+  -- | Apply a function to the components of two vectors.
+  --
+  -- * For a dense vector this is equivalent to 'liftA2'.
+  --
+  -- * For a sparse vector this is equivalent to 'intersectionWith'.
+  liftI2 :: (a -> b -> c) -> f a -> f b -> f c
+#ifndef HLINT
+  default liftI2 :: Applicative f => (a -> b -> c) -> f a -> f b -> f c
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
+#endif
+
+instance Additive ZipList where
+  zero = ZipList []
+  {-# INLINE zero #-}
+  liftU2 f (ZipList xs) (ZipList ys) = ZipList (liftU2 f xs ys)
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
+
+instance Additive Vector where
+  zero = mempty
+  {-# INLINE zero #-}
+  liftU2 f u v = case compare lu lv of
+    LT | lu == 0   -> v
+       | otherwise -> modify (\ w -> Foldable.forM_ [0..lu-1] $ \i -> unsafeWrite w i $ f (unsafeIndex u i) (unsafeIndex v i)) v
+    EQ -> Vector.zipWith f u v
+    GT | lv == 0   -> u
+       | otherwise -> modify (\ w -> Foldable.forM_ [0..lv-1] $ \i -> unsafeWrite w i $ f (unsafeIndex u i) (unsafeIndex v i)) u
+    where
+      lu = Vector.length u
+      lv = Vector.length v
+  {-# INLINE liftU2 #-}
+  liftI2 = Vector.zipWith
+  {-# INLINE liftI2 #-}
+
+instance Additive Maybe where
+  zero = Nothing
+  {-# INLINE zero #-}
+  liftU2 f (Just a) (Just b) = Just (f a b)
+  liftU2 _ Nothing ys = ys
+  liftU2 _ xs Nothing = xs
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
+
+instance Additive [] where
+  zero = []
+  {-# INLINE zero #-}
+  liftU2 f = go where
+    go (x:xs) (y:ys) = f x y : go xs ys
+    go [] ys = ys
+    go xs [] = xs
+  {-# INLINE liftU2 #-}
+  liftI2 = Prelude.zipWith
+  {-# INLINE liftI2 #-}
+
 instance Additive IntMap where
   zero = IntMap.empty
+  {-# INLINE zero #-}
   liftU2 = IntMap.unionWith
+  {-# INLINE liftU2 #-}
+  liftI2 = IntMap.intersectionWith
+  {-# INLINE liftI2 #-}
 
 instance Ord k => Additive (Map k) where
   zero = Map.empty
+  {-# INLINE zero #-}
   liftU2 = Map.unionWith
+  {-# INLINE liftU2 #-}
+  liftI2 = Map.intersectionWith
+  {-# INLINE liftI2 #-}
 
 instance (Eq k, Hashable k) => Additive (HashMap k) where
   zero = HashMap.empty
+  {-# INLINE zero #-}
   liftU2 = HashMap.unionWith
+  {-# INLINE liftU2 #-}
+  liftI2 = HashMap.intersectionWith
+  {-# INLINE liftI2 #-}
 
-instance Additive ((->) b)
+instance Additive ((->) b) where
+  zero   = const 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
-instance Additive Complex
+instance Additive Complex where
+  zero = 0 :+ 0
+  {-# INLINE zero #-}
+  liftU2 f (a :+ b) (c :+ d) = f a c :+ f b d
+  {-# INLINE liftU2 #-}
+  liftI2 f (a :+ b) (c :+ d) = f a c :+ f b d
+  {-# INLINE liftI2 #-}
 
-instance Additive Identity
+instance Additive Identity where
+  zero = Identity 0
+  {-# INLINE zero #-}
+  liftU2 = liftA2
+  {-# INLINE liftU2 #-}
+  liftI2 = liftA2
+  {-# INLINE liftI2 #-}
 
 -- | Compute the negation of a vector
 --
@@ -156,3 +294,10 @@
 basisFor v = [ setElement k 1 z | k <- [0..n-1] ]
   where z = 0 <$ v
         n = getSum $ foldMap (const (Sum 1)) v
+
+-- | Produce a diagonal matrix from a vector.
+kronecker :: (Applicative t, Num a, Traversable t) => t a -> t (t a)
+kronecker v = snd $ mapAccumL aux 0 v
+  where aux i e = let i' = i + 1
+                  in i' `seq` (i', setElement i e z)
+        z = pure 0