diff --git a/bench/bench.hs b/bench/bench.hs
--- a/bench/bench.hs
+++ b/bench/bench.hs
@@ -11,10 +11,20 @@
 threeInts :: IO (Int,Int,Int)
 threeInts = (,,) <$> randomIO <*> randomIO <*> randomIO
 
+int :: IO Int
+int = randomIO
+
 sumAtSize :: Int -> Benchmark
 sumAtSize n =
     env (replicateM n threeInts) $
     \xs ->
          bgroup (show n) [bench "add" $ nf add xs]
+
+prodAtSize :: Int -> Int -> Benchmark
+prodAtSize n m =
+    env ((,) <$> replicateM n int <*> replicateM m int) $
+    \xs ->
+         bench "prod-list" (nf (uncurry (<.>)) xs)
+
 main :: IO ()
-main = defaultMain [sumAtSize 10000]
+main = defaultMain [prodAtSize 2000 1000, sumAtSize 10000]
diff --git a/semiring-num.cabal b/semiring-num.cabal
--- a/semiring-num.cabal
+++ b/semiring-num.cabal
@@ -1,5 +1,5 @@
 name:                semiring-num
-version:             1.3.0.0
+version:             1.4.0.0
 synopsis:            Basic semiring class and instances
 description:         Adds a basic semiring class
 homepage:            https://github.com/oisdk/semiring-num
@@ -24,6 +24,11 @@
                      , template-haskell >= 2.11
                      , containers >= 0.5
                      , log-domain >= 0.10
+                     , scientific >= 0.3
+                     , time >= 1.6
+                     , unordered-containers >= 0.2
+                     , vector >= 0.12
+                     , hashable >= 1.2
   default-language:    Haskell2010
   ghc-options:         -Wall
 
diff --git a/src/Data/Semiring.hs b/src/Data/Semiring.hs
--- a/src/Data/Semiring.hs
+++ b/src/Data/Semiring.hs
@@ -7,6 +7,7 @@
 {-# LANGUAGE DeriveTraversable #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE BangPatterns #-}
 
 {-|
 Module: Data.Semiring
@@ -58,11 +59,16 @@
 import System.Posix.Types
        (CCc, CDev, CGid, CIno, CMode, CNlink, COff, CPid, CRLim, CSpeed,
         CSsize, CTcflag, CUid, Fd)
+import Data.Scientific(Scientific)
+import Data.Time.Clock(DiffTime,NominalDiffTime)
+
 import Data.Semigroup hiding (Max(..), Min(..))
+
 import Data.Coerce
 import GHC.Generics (Generic, Generic1)
 import Data.Typeable (Typeable)
 import Foreign.Storable (Storable)
+
 import Data.Semiring.TH
 import Data.Functor.Classes
 import Text.Read
@@ -73,12 +79,17 @@
 import Data.Set (Set)
 import qualified Data.Set as Set
 
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.HashSet as HashSet
+import Data.Hashable
+
 import Numeric.Log hiding (sum)
 import qualified Numeric.Log
 
 import Control.Monad
 import Control.Applicative
 import Data.Foldable
+import Data.Traversable
 
 -- $setup
 -- >>> import Data.Function
@@ -363,12 +374,21 @@
     (x:xs) <+> (y:ys) = (x <+> y) : (xs <+> ys)
     [] <.> _ = []
     _ <.> [] = []
-    (x:xs) <.> (y:ys) =
-        (x <.> y) : (map (x <.>) ys <+> map (<.> y) xs <+> (xs <.> ys))
+    (x:xs) <.> (y:ys) = (x <.> y) : add' xs ys
+      where
+        add' xs' [] = map (<.> y) xs'
+        add' [] ys' = map (x <.>) ys'
+        add' xs' ys' =
+            map (x <.>) ys' <+> map (<.> y) xs' <+> (zero : (xs' <.> ys'))
 
-instance Semiring a =>
+instance StarSemiring a => StarSemiring [a] where
+    star [] = one
+    star (x:xs) = r where
+      r = [star x] <.> (one : (xs <.> r))
+
+instance DetectableZero a =>
          DetectableZero [a] where
-    isZero = null
+    isZero = all isZero
     {-# INLINE isZero #-}
 
 instance (Monoid a, Ord a) =>
@@ -382,6 +402,16 @@
     {-# INLINE zero #-}
     {-# INLINE one #-}
 
+instance (Monoid a, Hashable a, Eq a) => Semiring (HashSet.HashSet a) where
+    (<+>) = HashSet.union
+    zero = HashSet.empty
+    one = HashSet.singleton mempty
+    xs <.> ys = foldMap (flip HashSet.map ys . mappend) xs
+    {-# INLINE (<+>) #-}
+    {-# INLINE (<.>) #-}
+    {-# INLINE zero #-}
+    {-# INLINE one #-}
+
 instance (Ord a, Monoid a, Semiring b) =>
          Semiring (Map a b) where
     one = Map.singleton mempty one
@@ -398,11 +428,31 @@
             , (l,u) <- Map.toList ys ]
     {-# INLINE (<.>) #-}
 
+instance (Hashable a, Monoid a, Semiring b, Eq a) =>
+         Semiring (HashMap.HashMap a b) where
+    one = HashMap.singleton mempty one
+    {-# INLINE one #-}
+    zero = HashMap.empty
+    {-# INLINE zero #-}
+    (<+>) = HashMap.unionWith (<+>)
+    {-# INLINE (<+>) #-}
+    xs <.> ys =
+        HashMap.fromListWith
+            (<+>)
+            [ (mappend k l, v <.> u)
+            | (k,v) <- HashMap.toList xs
+            , (l,u) <- HashMap.toList ys ]
+    {-# INLINE (<.>) #-}
+
 instance (Monoid a, Ord a) =>
          DetectableZero (Set a) where
     isZero = Set.null
     {-# INLINE isZero #-}
 
+instance (Monoid a, Hashable a, Eq a) =>
+         DetectableZero (HashSet.HashSet a) where
+    isZero = HashSet.null
+
 instance (Precise a, RealFloat a) => Semiring (Log a) where
     (<.>) = (*)
     {-# INLINE (<.>) #-}
@@ -420,24 +470,9 @@
     {-# INLINE isZero #-}
 
 --------------------------------------------------------------------------------
--- Addition and multiplication newtypes
+-- Newtype utilities
 --------------------------------------------------------------------------------
-type WrapBinary f a = (a -> a -> a) -> f a -> f a -> f a
 
--- | Monoid under '<+>'. Analogous to 'Data.Monoid.Sum', but uses the
--- 'Semiring' constraint, rather than 'Num'.
-newtype Add a = Add
-    { getAdd :: a
-    } deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable
-               ,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable
-               ,Semiring,DetectableZero,StarSemiring)
-
-instance Eq1 Add where
-    liftEq = coerce
-
-instance Ord1 Add where
-    liftCompare = coerce
-
 showsNewtype :: Coercible b a => String -> String -> (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> b -> ShowS
 showsNewtype cons acc = s
   where
@@ -460,11 +495,34 @@
         Punc "}" <- lexP
         pure (coerce x)
 
+--------------------------------------------------------------------------------
+-- Addition and multiplication newtypes
+--------------------------------------------------------------------------------
+type WrapBinary f a = (a -> a -> a) -> f a -> f a -> f a
+
+-- | Monoid under '<+>'. Analogous to 'Data.Monoid.Sum', but uses the
+-- 'Semiring' constraint, rather than 'Num'.
+newtype Add a = Add
+    { getAdd :: a
+    } deriving (Eq,Ord,Read,Show,Bounded,Generic,Generic1,Num,Enum,Typeable
+               ,Storable,Fractional,Real,RealFrac,Functor,Foldable,Traversable
+               ,Semiring,DetectableZero,StarSemiring)
+
+instance Eq1 Add where
+    liftEq = coerce
+    {-# INLINE liftEq #-}
+
+instance Ord1 Add where
+    liftCompare = coerce
+    {-# INLINE liftCompare #-}
+
 instance Show1 Add where
     liftShowsPrec = showsNewtype "Add" "getAdd"
+    {-# INLINE liftShowsPrec #-}
 
 instance Read1 Add where
     liftReadsPrec = readsNewtype "Add" "getAdd"
+    {-# INLINE liftReadsPrec #-}
 
 -- | Monoid under '<.>'. Analogous to 'Data.Monoid.Product', but uses the
 -- 'Semiring' constraint, rather than 'Num'.
@@ -476,15 +534,19 @@
 
 instance Eq1 Mul where
     liftEq = coerce
+    {-# INLINE liftEq #-}
 
 instance Ord1 Mul where
     liftCompare = coerce
+    {-# INLINE liftCompare #-}
 
 instance Show1 Mul where
     liftShowsPrec = showsNewtype "Mul" "getMul"
+    {-# INLINE liftShowsPrec #-}
 
 instance Read1 Mul where
     liftReadsPrec = readsNewtype "Mul" "getMul"
+    {-# INLINE liftReadsPrec #-}
 
 instance Semiring a =>
          Semigroup (Add a) where
@@ -563,16 +625,17 @@
     (<.>) = mulMatrix
     (<+>) = liftA2 (<+>)
     zero = pure zero
-    one = case zero of
-      Matrix xs -> Matrix (imap (\i -> imap (\j x -> if i == j then one else x)) xs)
-
-newtype State a = State (Int -> (a, Int)) deriving Functor
+    one =
+        (coerce :: (f (g a) -> f (g a)) -> Matrix f g a -> Matrix f g a)
+            (imap (\i -> imap (\j z -> if i == j then o else z))) zero
+      where
+        imap f = snd . mapAccumL (\ !i x -> (i + 1, f i x)) (0 :: Int)
+        o :: a
+        o = one
 
-instance Applicative State where
-    pure x = State (\i -> (x, i))
-    State fs <*> State xs = State (\i -> case fs i of
-                                      (f, i') -> case xs i' of
-                                        (x,i'') -> (f x, i''))
+instance (Traversable f, Applicative f, DetectableZero a, f ~ g) =>
+         DetectableZero (Matrix f g a) where
+    isZero = all isZero
 
 -- | Transpose the matrix.
 transpose :: (Applicative g, Traversable f) => Matrix f g a -> Matrix g f a
@@ -588,13 +651,6 @@
   where
     c = sequenceA ys
 
-evalState :: State a -> Int -> a
-evalState (State r) i = case r i of
-  (x,_) -> x
-
-imap :: Traversable t => (Int -> a -> b) -> t a -> t b
-imap f xs = evalState (traverse (\x -> State (\i -> (f i x, i + 1))) xs) 0
-
 infixr 9 #.
 (#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c
 (#.) _ = coerce
@@ -1027,6 +1083,36 @@
     {-# INLINE (<+>) #-}
     {-# INLINE (<.>) #-}
 
+instance Semiring Scientific where
+    one = 1
+    zero = 0
+    (<+>) = (+)
+    (<.>) = (*)
+    {-# INLINE zero #-}
+    {-# INLINE one #-}
+    {-# INLINE (<+>) #-}
+    {-# INLINE (<.>) #-}
+
+instance Semiring DiffTime where
+    one = 1
+    zero = 0
+    (<+>) = (+)
+    (<.>) = (*)
+    {-# INLINE zero #-}
+    {-# INLINE one #-}
+    {-# INLINE (<+>) #-}
+    {-# INLINE (<.>) #-}
+
+instance Semiring NominalDiffTime where
+    one = 1
+    zero = 0
+    (<+>) = (+)
+    (<.>) = (*)
+    {-# INLINE zero #-}
+    {-# INLINE one #-}
+    {-# INLINE (<+>) #-}
+    {-# INLINE (<.>) #-}
+
 instance Semiring CUIntMax where
     one = 1
     zero = 0
@@ -1559,6 +1645,18 @@
     {-# INLINE isZero #-}
 
 instance DetectableZero Double where
+    isZero = isZeroEq
+    {-# INLINE isZero #-}
+
+instance DetectableZero Scientific where
+    isZero = isZeroEq
+    {-# INLINE isZero #-}
+
+instance DetectableZero DiffTime where
+    isZero = isZeroEq
+    {-# INLINE isZero #-}
+
+instance DetectableZero NominalDiffTime where
     isZero = isZeroEq
     {-# INLINE isZero #-}
 
diff --git a/src/Test/Semiring.hs b/src/Test/Semiring.hs
--- a/src/Test/Semiring.hs
+++ b/src/Test/Semiring.hs
@@ -160,7 +160,7 @@
     rp = x <.> r
     s =
         unlines
-            [ "<+> is " ++
+            [ "<.> is " ++
               (if res
                    then ""
                    else "not ") ++
@@ -309,7 +309,7 @@
               (if res
                    then ""
                    else " not") ++
-              " the identity of <+>."
+              " the identity of <.>."
             , "    Law:"
             , "        x <.> one = one <.> x = x"
             , "    x = " ++ show x
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -9,6 +9,7 @@
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TypeOperators              #-}
 {-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE KindSignatures             #-}
 {-# OPTIONS_GHC -fno-warn-orphans       #-}
 
 module Main (main) where
@@ -16,6 +17,7 @@
 import           Control.Applicative
 
 import           Control.Arrow            (first)
+import           Data.Function
 import           Data.Bool
 import           Data.Proxy
 
@@ -115,6 +117,44 @@
 type Tup8 a = (a,a,a,a,a,a,a,a)
 type Tup9 a = (a,a,a,a,a,a,a,a,a)
 
+refListMul
+    :: Semiring a
+    => [a] -> [a] -> [a]
+refListMul [] _ = []
+refListMul _ [] = []
+refListMul (x:xs) (y:ys) =
+    (x <.> y) :
+    (map (x <.>) ys <+> map (<.> y) xs <+> (zero : refListMul xs ys))
+
+newtype Polynomial a =
+    Polynomial [a]
+    deriving (Show,Arbitrary,Semiring,DetectableZero)
+
+instance (Monad m, Serial m a) => Serial m (Polynomial a) where
+    series = fmap Polynomial series
+
+instance (DetectableZero a, Eq a) => Eq (Polynomial a) where
+    Polynomial xs' == Polynomial ys' = go xs' ys' where
+      go [] ys = isZero ys
+      go xs [] = isZero xs
+      go (x:xs) (y:ys) = x == y && go xs ys
+
+newtype LimitSize (n :: Nat) a =
+    LimitSize [a]
+    deriving (Arbitrary,Semiring,DetectableZero,StarSemiring)
+
+takeFirst :: KnownNat n => LimitSize n a -> [a]
+takeFirst (LimitSize xs :: LimitSize n a) = take (fromInteger (natVal (Proxy :: Proxy n))) xs
+
+instance (Monad m, Serial m a) => Serial m (LimitSize n a) where
+    series = fmap LimitSize series
+
+instance (Eq a, KnownNat n) => Eq (LimitSize n a) where
+    (==) = (==) `on` takeFirst
+
+instance (Show a, KnownNat n) => Show (LimitSize n a) where
+    showsPrec n = showsPrec n . takeFirst
+
 main :: IO ()
 main = do
     doctest ["-isrc", "src/"]
@@ -122,7 +162,9 @@
         testGroup
             "Tests"
             [ let p = Proxy :: Proxy (Map String Int)
-              in testGroup "Map" [localOption (QC.QuickCheckMaxSize 10) $ semiringLawsQC p]
+              in testGroup
+                     "Map"
+                     [localOption (QC.QuickCheckMaxSize 10) $ semiringLawsQC p]
             , let p = Proxy :: Proxy (Matrix Quad Quad Integer)
               in testGroup "Matrix" [semiringLawsQC p]
             , let p = Proxy :: Proxy Integer
@@ -130,9 +172,9 @@
                      "Integer"
                      [semiringLawsSC p, ordLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Func Bool Bool)
-              in testGroup "Bool -> Bool"
-                     [semiringLawsQC p]
-            , testGroup "Endo Bool"
+              in testGroup "Bool -> Bool" [semiringLawsQC p]
+            , testGroup
+                  "Endo Bool"
                   [ QC.testProperty
                         "plusId"
                         (plusId :: UnaryLaws (EndoFunc (Add Bool)))
@@ -162,9 +204,7 @@
             , let p = Proxy :: Proxy Int
               in testGroup "Int" [semiringLawsSC p, ordLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (WordOfSize 2)
-              in testGroup
-                     "WordOfSize 2"
-                     [semiringLawsSC p, zeroLawsSC p]
+              in testGroup "WordOfSize 2" [semiringLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Tup2 (WordOfSize 2))
               in testGroup
                      "Tup2 (WordOfSize 2)"
@@ -174,61 +214,33 @@
                      "Tup3 (WordOfSize 2)"
                      [semiringLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Tup4 Int)
-              in testGroup
-                     "Tup4 Int"
-                     [semiringLawsQC p, zeroLawsQC p]
+              in testGroup "Tup4 Int" [semiringLawsQC p, zeroLawsQC p]
             , let p = Proxy :: Proxy (Tup5 Int)
-              in testGroup
-                     "Tup5 Int"
-                     [semiringLawsQC p, zeroLawsQC p]
+              in testGroup "Tup5 Int" [semiringLawsQC p, zeroLawsQC p]
             , let p = Proxy :: Proxy (Tup6 Int)
-              in testGroup
-                     "Tup6 Int"
-                     [semiringLawsQC p, zeroLawsQC p]
+              in testGroup "Tup6 Int" [semiringLawsQC p, zeroLawsQC p]
             , let p = Proxy :: Proxy (Tup7 Int)
-              in testGroup
-                     "Tup7 Int"
-                     [semiringLawsQC p, zeroLawsQC p]
+              in testGroup "Tup7 Int" [semiringLawsQC p, zeroLawsQC p]
             , let p = Proxy :: Proxy (Tup8 Int)
-              in testGroup
-                     "Tup8 Int"
-                     [semiringLawsQC p, zeroLawsQC p]
+              in testGroup "Tup8 Int" [semiringLawsQC p, zeroLawsQC p]
             , let p = Proxy :: Proxy (Tup9 Int)
-              in testGroup
-                     "Tup9 Int"
-                     [semiringLawsQC p, zeroLawsQC p]
+              in testGroup "Tup9 Int" [semiringLawsQC p, zeroLawsQC p]
             , let p = Proxy :: Proxy (Tup2 (PositiveInfinite (WordOfSize 2)))
-              in testGroup
-                     "Tup2 (WordOfSize 2)"
-                     [starLawsSC p]
+              in testGroup "Tup2 (WordOfSize 2)" [starLawsSC p]
             , let p = Proxy :: Proxy (Tup3 (PositiveInfinite (WordOfSize 2)))
-              in testGroup
-                     "Tup3 (WordOfSize 2)"
-                     [starLawsSC p]
+              in testGroup "Tup3 (WordOfSize 2)" [starLawsSC p]
             , let p = Proxy :: Proxy (Tup4 (PositiveInfinite Int))
-              in testGroup
-                     "Tup4 Int"
-                     [starLawsQC p]
+              in testGroup "Tup4 Int" [starLawsQC p]
             , let p = Proxy :: Proxy (Tup5 (PositiveInfinite Int))
-              in testGroup
-                     "Tup5 Int"
-                     [starLawsQC p]
+              in testGroup "Tup5 Int" [starLawsQC p]
             , let p = Proxy :: Proxy (Tup6 (PositiveInfinite Int))
-              in testGroup
-                     "Tup6 Int"
-                     [starLawsQC p]
+              in testGroup "Tup6 Int" [starLawsQC p]
             , let p = Proxy :: Proxy (Tup7 (PositiveInfinite Int))
-              in testGroup
-                     "Tup7 Int"
-                     [starLawsQC p]
+              in testGroup "Tup7 Int" [starLawsQC p]
             , let p = Proxy :: Proxy (Tup8 (PositiveInfinite Int))
-              in testGroup
-                     "Tup8 Int"
-                     [starLawsQC p]
+              in testGroup "Tup8 Int" [starLawsQC p]
             , let p = Proxy :: Proxy (Tup9 (PositiveInfinite Int))
-              in testGroup
-                     "Tup9 Int"
-                     [starLawsQC p]
+              in testGroup "Tup9 Int" [starLawsQC p]
             , testGroup
                   "Negative Infinite Integer"
                   [ SC.testProperty
@@ -296,25 +308,31 @@
                      "All"
                      [semiringLawsSC p, ordLawsSC p, zeroLawsSC p, starLawsSC p]
             , let p = Proxy :: Proxy [WordOfSize 2]
-              in testGroup "[WordOfSize 2]" [semiringLawsSC p, zeroLawsSC p]
-            , let p = Proxy :: Proxy (Min (PositiveInfinite Integer))
               in testGroup
-                     "Min Inf Integer"
-                     [semiringLawsSC p, zeroLawsSC p]
+                     "[WordOfSize 2]"
+                     [ semiringLawsSC p
+                     , semiringLawsQC p
+                     , starLawsSC (Proxy :: Proxy (LimitSize 10000 (PositiveInfinite Integer)))
+                     , starLawsQC (Proxy :: Proxy (LimitSize 10000 (PositiveInfinite Integer)))
+                     , QC.testProperty
+                           "reference implementation of <.>"
+                           (\xs ys ->
+                                 Polynomial (xs <.> ys) ===
+                                 Polynomial (refListMul xs (ys :: [WordOfSize 2])))]
+            , let p = Proxy :: Proxy (Min (PositiveInfinite Integer))
+              in testGroup "Min Inf Integer" [semiringLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Min (Infinite Integer))
-              in testGroup
-                     "Min Inf Integer"
-                     [starLawsSC p]
+              in testGroup "Min Inf Integer" [starLawsSC p]
             , let p = Proxy :: Proxy (Max (NegativeInfinite Integer))
               in testGroup
                      "Max NegInf Integer"
                      [semiringLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Max (Infinite Integer))
-              in testGroup
-                     "Max Inf Integer"
-                     [starLawsSC p]
+              in testGroup "Max Inf Integer" [starLawsSC p]
             , let p = Proxy :: Proxy (Free (WordOfSize 2))
-              in testGroup "Free (WordOfSize 2)" [localOption (QC.QuickCheckMaxSize 10) $ semiringLawsQC p]
+              in testGroup
+                     "Free (WordOfSize 2)"
+                     [localOption (QC.QuickCheckMaxSize 10) $ semiringLawsQC p]
             , let p = Proxy :: Proxy (Division (SC.Positive Integer))
               in testGroup "Division Integer" [semiringLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Łukasiewicz Fraction)
@@ -322,11 +340,10 @@
                      "Łukasiewicz Fraction"
                      [semiringLawsSC p, zeroLawsSC p]
             , let p = Proxy :: Proxy (Viterbi Fraction)
-              in testGroup "Viterbi Fraction" [semiringLawsSC p, zeroLawsSC p]]
-            -- , let p = Proxy :: Proxy (Log (Approx Double))
-            --   in testGroup
-            --          "Log (Approx Double)"
-            --          [semiringLawsQC p, zeroLawsQC p]]
+              in testGroup "Viterbi Fraction" [semiringLawsSC p, zeroLawsSC p]]-- , let p = Proxy :: Proxy (Log (Approx Double))
+                                                                               --   in testGroup
+                                                                               --          "Log (Approx Double)"
+                                                                               --          [semiringLawsQC p, zeroLawsQC p]]
 
 
 ------------------------------------------------------------------------