diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,9 @@
+# 0.4.0.0
+
+- Check well-formedness of constructor distributions at compile time.
+- No longer support GHC 7.10.3 (the above feature relies on Generic
+  information which does not exist before GHC 8)
+
 # 0.3.0.0
 
 - Support GHC 7.10.3
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,4 +1,4 @@
-Generic random generators [![Hackage](https://img.shields.io/hackage/v/generic-random.svg)](https://hackage.haskell.org/package/generic-random) [![Build Status](https://travis-ci.org/Lysxia/generic-random.svg)](https://travis-ci.org/Lysxia/generic-random.svg?branch=master)
+Generic random generators [![Hackage](https://img.shields.io/hackage/v/generic-random.svg)](https://hackage.haskell.org/package/generic-random) [![Build Status](https://travis-ci.org/Lysxia/generic-random.svg)](https://travis-ci.org/Lysxia/generic-random)
 =========================
 
 `Generic.Random.Data`
@@ -50,7 +50,7 @@
       deriving (Show, Generic)
 
     instance Arbitrary a => Arbitrary (Tree a) where
-      arbitrary = genericArbitrary' Z
+      arbitrary = genericArbitrary' Z uniform
 
     -- Equivalent to
     -- > arbitrary =
@@ -66,7 +66,7 @@
     main = sample (arbitrary :: Gen (Tree ()))
 ```
 
-- User-specified distribution of constructors.
+- User-specified distribution of constructors, with compile-time checks.
 - A simple (optional) strategy to ensure termination: `Test.QuickCheck.Gen`'s
   size parameter decreases at every recursive `genericArbitrary'` call; when it
   reaches zero, sample directly from a finite set of finite values.
diff --git a/bench/binaryTree.hs b/bench/binaryTree.hs
--- a/bench/binaryTree.hs
+++ b/bench/binaryTree.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
 module Main where
 
 import Control.Applicative
@@ -10,6 +10,7 @@
 import GHC.Generics
 import Control.DeepSeq
 import Criterion.Main
+import Test.Feat
 import Test.QuickCheck
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Random
@@ -19,10 +20,16 @@
 import Generic.Random.Internal.Types
 
 data T = N T T | L
-  deriving (Eq, Ord, Show, Data, Generic)
+  deriving (Eq, Ord, Show, Data, Typeable, Generic)
 
 instance NFData T
 
+deriveEnumerable ''T
+
+size :: Num a => T -> a
+size L = 1
+size (N l r) = 1 + size l + size r
+
 gen1 :: Int -> Gen T
 gen1 n = runRejectT (tolerance epsilon (n + 1)) gen'
   where
@@ -39,19 +46,17 @@
         (k (n+1) L)
         (gen' (n+1) $ \m l -> gen' m $ \m r -> k m (N l r))
 
-main = getGs >>= \gs -> defaultMain $ liftA2 (\n f -> f n gs)
-  [4 ^ e | e <- [1 .. 5]]
+genFeat :: Int -> Gen T
+genFeat = uniform
 
+main = newQCGen >>= \g -> defaultMain $ liftA2 (\n f -> f n g)
+  [4 ^ e | e <- [1 .. 6]]
+
   -- Singular rejection sampling
   [ bg "handwritten1" gen1
   , bg "handwritten2" gen2
-  , bg "SR" generatorSR
 
-  -- Sized rejection sampling
-  , bg "R" generatorR'
-
-  -- Sized rejection sampling, not memoizing oracle
-  , bg' "R-recomp" generatorR'
+  , bg "feat" genFeat
 
   -- Pointed generator
   , bg "P" generatorP'
@@ -59,20 +64,33 @@
   -- Pointed generator with rejection sampling
   , bg "PR" generatorPR'
 
+  , bg "SR" generatorSR
+
+  -- Sized rejection sampling
+  , bg "R" generatorR'
+
+  -- Sized rejection sampling, not memoizing oracle
+  , bg' "R-recomp" generatorR'
+
   -- Pointed generator, not memoizing oracle
   , bg' "P-recomp" generatorP'
   ]
 
-bg, bg' :: String -> (Int -> Gen T) -> Int -> [QCGen] -> Benchmark
-bg name gen n gs =
-  bench (name ++ "_" ++ show n) $
-    nf (fmap (\g -> unGen gg g 0)) gs
+bg, bg' :: String -> (Int -> Gen T) -> Int -> QCGen -> Benchmark
+bg name gen n g =
+  bench (name ++ "_" ++ show n) $ nf f g
   where
+    go 0 = return (0 :: Int)
+    go k = liftA2 (\t s -> size t + s) gg (go (k-1))
     gg = gen n
+    f g = unGen (go 100) g 0
 
-bg' name gen n gs =
-  bench (name ++ "_" ++ show n) $
-    nf (fmap (\(n, g) -> unGen (gen n) g 0)) (fmap ((,) n) gs)
+bg' name gen n g =
+  bench (name ++ "_" ++ show n) $ nf f (n, g)
+  where
+    go n 0 = return (0 :: Int)
+    go n k = liftA2 (\t s -> size t + s) (gen n) (go n (k-1))
+    f (n, g) = unGen (go n 100) g 0
 
-getGs :: IO [QCGen]
-getGs = replicateM 100 newQCGen
+avgSize :: [T] -> Double
+avgSize ts = sum (fmap size ts) / fromIntegral (length ts)
diff --git a/generic-random.cabal b/generic-random.cabal
--- a/generic-random.cabal
+++ b/generic-random.cabal
@@ -1,5 +1,5 @@
 name:                generic-random
-version:             0.3.0.0
+version:             0.4.0.0
 synopsis:            Generic random generators
 description:         Please see the README.
 homepage:            http://github.com/lysxia/generic-random
@@ -12,8 +12,15 @@
 build-type:          Simple
 extra-source-files:  README.md CHANGELOG.md
 cabal-version:       >=1.10
-tested-with:         GHC == 7.10.3, GHC == 8.0.1
+tested-with:         GHC == 8.0.1
 
+flag test
+  Description:
+    Enable testing. Disabled by default because the current test suite
+    is slow and can fail with non-zero probability.
+  Manual:  True
+  Default: False
+
 library
   hs-source-dirs:      src
   exposed-modules:
@@ -27,7 +34,7 @@
     Generic.Random.Internal.Solver
     Generic.Random.Internal.Types
   build-depends:
-    base >= 4.8 && < 5,
+    base >= 4.9 && < 4.10,
     containers,
     hashable,
     unordered-containers,
@@ -47,26 +54,35 @@
   hs-source-dirs:   test
   main-is:          tree.hs
   default-language: Haskell2010
-  build-depends:
-    base,
-    QuickCheck,
-    generic-random
   other-modules:
     Test.Stats,
     Test.Tree
+  if flag(test)
+    build-depends:
+      base,
+      QuickCheck,
+      optparse-generic,
+      generic-random
+  else
+    buildable: False
 
 benchmark bench-binarytree
   type:             exitcode-stdio-1.0
   hs-source-dirs:   bench
   main-is:          binaryTree.hs
   default-language: Haskell2010
-  build-depends:
-    base,
-    criterion,
-    deepseq,
-    QuickCheck,
-    transformers,
-    generic-random
+  ghc-options: -O2
+  if flag(test)
+    build-depends:
+      base,
+      criterion,
+      deepseq,
+      QuickCheck,
+      transformers,
+      testing-feat,
+      generic-random
+  else
+    buildable: False
 
 source-repository head
   type:     git
diff --git a/src/Generic/Random/Generic.hs b/src/Generic/Random/Generic.hs
--- a/src/Generic/Random/Generic.hs
+++ b/src/Generic/Random/Generic.hs
@@ -2,34 +2,213 @@
 --
 -- Here is an example. Define your type.
 --
--- > data Tree a = Leaf a | Node (Tree a) (Tree a)
--- >   deriving Generic
+-- @
+-- data Tree a = Leaf a | Node (Tree a) (Tree a)
+--   deriving Generic
+-- @
 --
--- Pick an arbitrary implementation.
+-- Pick an 'arbitrary' implementation.
 --
--- > instance Arbitrary a => Arbitrary (Tree a) where
--- >   arbitrary = genericArbitraryFrequency [9, 8]
+-- @
+-- instance Arbitrary a => Arbitrary (Tree a) where
+--   arbitrary = 'genericArbitrary' ('weights' (9 '%' 8 '%' ()))
+-- @
 --
 -- @arbitrary :: 'Gen' (Tree a)@ picks a @Leaf@ with probability 9\/17, or a
 -- @Node@ with probability 8\/17, and recursively fills their fields with
 -- @arbitrary@.
+--
+-- == Distribution of constructors
+--
+-- The distribution of constructors can be specified using 'weights' applied to
+-- a special list of /weights/ in the same order as the data type definition.
+-- This assigns to each constructor a probability proportional to its weight;
+-- in other words, @p_C = weight_C / sumOfWeights@.
+--
+-- The list of weights is built up with the @('%')@ operator as a cons, and using
+-- the unit @()@ as the empty list, in the order corresponding to the data type
+-- definition.
+--
+-- For @Tree@, 'genericArbitrary' produces code equivalent to the following:
+--
+-- @
+-- 'genericArbitrary' :: Arbitrary a => 'Weights' (Tree a) -> Gen (Tree a)
+-- 'genericArbitrary' ('weighted' (x '%' y '%' ())) =
+--   frequency
+--     [ (x, Leaf \<$\> arbitrary)
+--     , (y, Node \<$\> arbitrary \<*\> arbitrary)
+--     ]
+-- @
+--
+-- The weights actually have type @'W' \"ConstructorName\"@ (just a newtype
+-- around 'Int'), so that you can annotate a weight with its corresponding
+-- constructor, and it will be checked that you got the order right.
+--
+-- This will type-check.
+--
+-- @
+-- 'weighted' ((x :: 'W' \"Leaf\") '%' (y :: 'W' \"Node\") '%' ()) :: 'Weights' (Tree a)
+-- 'weighted' (x '%' (y :: 'W' \"Node\") '%' ()) :: 'Weights' (Tree a)
+-- @
+--
+-- This will not: the first requires an order of constructors different from
+-- the definition of the @Tree@ type; the second doesn't have the right number
+-- of weights.
+--
+-- @
+-- 'weighted' ((x :: 'W' \"Node\") '%' y '%' ()) :: 'Weights' (Tree a)
+-- 'weighted' (x '%' y '%' z '%' ()) :: 'Weights' (Tree a)
+-- @
+--
+-- === Uniform distribution
+--
+-- You can specify the uniform distribution with 'uniform'.
+--
+-- For @Tree@, @'genericArbitrary' 'uniform'@ produces code equivalent to the
+-- following:
+--
+-- @
+-- 'genericArbitrary' 'uniform' :: Arbitrary a => Gen (Tree a)
+-- 'genericArbitrary' 'uniform' =
+--   oneof
+--     [ Leaf \<$\> arbitrary                -- Uses Arbitrary a
+--     , Node \<$\> arbitrary \<*\> arbitrary  -- Uses Arbitrary (Tree a)
+--     ]
+-- @
+--
+-- Note that for many types, a uniform distribution tends to produce big
+-- values. For instance for @Tree a@, generated values are finite but the
+-- __average__ number of @Leaf@ and @Node@ constructors is __infinite__.
+--
+-- == Ensuring termination
+--
+-- As was just mentioned, one must be careful with recursive types
+-- to avoid producing extremely large values.
+--
+-- The alternative 'genericArbitrary'' implements a simple strategy to keep
+-- values at reasonable sizes: the size parameter of 'Gen' is divided among the
+-- fields of the chosen constructor. When it reaches zero, the generator
+-- selects a finite term whenever it can find any of the given type.  This
+-- generally ensures that the number of constructors remains close to the
+-- initial size parameter passed to 'Gen'.
+--
+-- A natural number @n@ determines the maximum /depth/ of terms that can be
+-- used to end recursion.
+-- It is encoded using @'Z' :: 'Z'@ and @'S' :: n -> 'S' n@.
+--
+-- @
+-- 'genericArbitrary'' n ('weights' (...))
+-- @
+--
+-- With @n = 'Z'@, the generator looks for a simple nullary constructor.  If none
+-- exist at the current type, as is the case for our @Tree@ type, it carries on
+-- as in 'genericArbitrary'.
+--
+-- @
+-- 'genericArbitrary'' 'Z' :: Arbitrary a => 'Weights' (Tree a) -> Gen (Tree a)
+-- 'genericArbitrary'' 'Z' ('weights' (x '%' y '%' ())) =
+--   frequency
+--     [ (x, Leaf \<$\> arbitrary)
+--     , (y, scale (\`div\` 2) $ Node \<$\> arbitrary \<*\> arbitrary)
+--     -- 2 because Node is 2-ary.
+--     ]
+-- @
+--
+-- Here is another example with nullary constructors:
+--
+-- @
+-- data Tree' = Leaf1 | Leaf2 | Node3 Tree' Tree' Tree'
+--   deriving Generic
+--
+-- instance Arbitrary Tree' where
+--   arbitrary = 'genericArbitrary'' 'Z' ('weights' (1 '%' 2 '%' 3 '%' ()))
+-- @
+--
+-- Here, @'genericArbitrary'' 'Z'@ is equivalent to:
+--
+-- @
+-- 'genericArbitrary'' 'Z' :: 'Weights' Tree' -> Gen Tree'
+-- 'genericArbitrary'' 'Z' ('weights' (x '%' y '%' z '%' ())) =
+--   sized $ \n ->
+--     if n == 0 then
+--       -- If the size parameter is zero, the non-nullary alternative is discarded.
+--       frequency $
+--         [ (x, return Leaf1)
+--         , (y, return Leaf2)
+--         ]
+--     else
+--       frequency $
+--         [ (x, return Leaf1)
+--         , (y, return Leaf2)
+--         , (z, resize (n \`div\` 3) node)  -- 3 because Node3 is 3-ary
+--         ]
+--   where
+--     node = Node3 \<$\> arbitrary \<*\> arbitrary \<*\> arbitrary
+-- @
+--
+-- To increase the chances of termination when no nullary constructor is directly
+-- available, such as in @Tree@, we can pass a larger depth @n@. The effectiveness
+-- of this parameter depends on the concrete type the generator is used for.
+--
+-- For instance, if we want to generate a value of type @Tree ()@, there is a
+-- value of depth 1 (represented by @'S' 'Z'@) that we can use to end
+-- recursion: @Leaf ()@.
+--
+-- @
+-- 'genericArbitrary'' ('S' 'Z') :: 'Weights' (Tree ()) -> Gen (Tree ())
+-- 'genericArbitrary'' ('S' 'Z') ('weights' (x '%' y '%' ())) =
+--   sized $ \n ->
+--     if n == 0 then
+--       return (Leaf ())
+--     else
+--       frequency
+--         [ (x, Leaf \<$\> arbitrary)
+--         , (y, scale (\`div\` 2) $ Node \<$\> arbitrary \<*\> arbitrary)
+--         ]
+-- @
+--
+-- Because the argument of @Tree@ must be inspected in order to discover
+-- values of type @Tree ()@, we incur some extra constraints if we want
+-- polymorphism.
+--
+-- @UndecidableInstances@ is also required.
+--
+-- @
+-- instance (Arbitrary a, Generic a, 'ListBaseCases' 'Z' (Rep a))
+--   => Arbitrary (Tree a) where
+--   arbitrary = 'genericArbitrary'' ('S' 'Z') ('weights' (1 '%' 2 '%' ()))
+-- @
+--
+-- A synonym is provided for brevity.
+--
+-- @
+-- instance (Arbitrary a, 'BaseCases'' Z a) => Arbitrary (Tree a) where
+--   arbitrary = 'genericArbitrary'' ('S' 'Z') ('weights' (1 '%' 2 '%' ()))
+-- @
 
+
 module Generic.Random.Generic
   (
     -- * Arbitrary implementations
     genericArbitrary
-  , genericArbitraryFrequency
-  , genericArbitraryFrequency'
   , genericArbitrary'
 
+    -- * Specifying finite distributions
+  , Weights
+  , W
+  , weights
+  , (%)
+  , uniform
+
     -- * Type-level natural numbers
     -- $nat
   , Z (..)
   , S (..)
 
-    -- * Generic class for finite values
+    -- * Generic classes for finite values
   , BaseCases'
   , BaseCases
+  , ListBaseCases
   ) where
 
 import Generic.Random.Internal.Generic
diff --git a/src/Generic/Random/Internal/Generic.hs b/src/Generic/Random/Internal/Generic.hs
--- a/src/Generic/Random/Internal/Generic.hs
+++ b/src/Generic/Random/Internal/Generic.hs
@@ -1,259 +1,212 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE DeriveFunctor, GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE UndecidableInstances #-}
+
 module Generic.Random.Internal.Generic where
 
 import Control.Applicative
 import Data.Coerce
+import GHC.Exts (Proxy#, proxy#)
 import GHC.Generics hiding ( S )
+import GHC.TypeLits
 import Test.QuickCheck
 
 -- * Random generators
 
--- | Pick a constructor with uniform probability, and fill its fields
+-- | Pick a constructor with a given distribution, and fill its fields
 -- recursively.
---
--- An equivalent definition for @Tree@ is:
---
--- > genericArbitrary :: Arbitrary a => Gen (Tree a)
--- > genericArbitrary =
--- >   oneof
--- >     [ Leaf <$> arbitrary                -- Uses Arbitrary a
--- >     , Node <$> arbitrary <*> arbitrary  -- Uses Arbitrary (Tree a)
--- >     ]
---
--- Note that for many types, 'genericArbitrary' tends to produce big values.
--- For instance for @Tree a@ values are finite but the average number of
--- @Leaf@ and @Node@ constructors is infinite.
+genericArbitrary
+  :: forall a
+  .  (Generic a, GA Unsized (Rep a))
+  => Weights a
+  -> Gen a
+genericArbitrary (Weights w n) = (unGen' . fmap to) (ga w n :: Gen' Unsized (Rep a p))
 
-genericArbitrary :: forall a. (Generic a, GA Unsized (Rep a)) => Gen a
-genericArbitrary =
-  (($ repeat 1) . unFreq . fmap to) (ga :: Freq Unsized (Rep a p))
+-- | Like 'genericArbitrary'', with bounded size to ensure termination for
+-- recursive types.
+genericArbitrary'
+  :: forall n a
+  . (Generic a, GA (Sized n) (Rep a))
+  => n
+  -> Weights a  -- ^ List of weights for every constructor
+  -> Gen a
+genericArbitrary' _ (Weights w n) =
+  (unGen' . fmap to) (ga w n :: Gen' (Sized n) (Rep a p))
 
 
--- | This allows to specify the probability distribution of constructors
--- as a list of weights, in the same order as the data type definition.
---
--- An equivalent definition for @Tree@ is:
---
--- > genericArbitraryFrequency :: Arbitrary a => [Int] -> Gen (Tree a)
--- > genericArbitraryFrequency [x, y] =
--- >   frequency
--- >     [ (x, Leaf <$> arbitrary)
--- >     , (y, Node <$> arbitrary <*> arbitrary)
--- >     ]
+-- * Internal
 
-genericArbitraryFrequency
-  :: forall a. (Generic a, GA Unsized (Rep a))
-  => [Int]  -- ^ List of weights for every constructor
-  -> Gen a
-genericArbitraryFrequency = (unFreq . fmap to) (ga :: Freq Unsized (Rep a p))
+type family Weights_ (f :: * -> *) :: * where
+  Weights_ (f :+: g) = Weights_ f :| Weights_ g
+  Weights_ (M1 D _c f) = Weights_ f
+  Weights_ (M1 C ('MetaCons c _i _j) _f) = L c
 
+data a :| b = N a Int b
+data L (c :: Symbol) = L
 
--- | The size parameter of 'Gen' is divided among the fields of the chosen
--- constructor.  When it reaches zero, the generator selects a finite term
--- whenever it can find any of the given type.
---
--- The natural number @n@ determines the maximum /depth/ of terms that can be
--- used to end recursion.
--- It is encoded using @'Z' :: 'Z'@ and @'S' :: n -> 'S' n@.
---
--- > genericArbitraryFrequency' n weights
---
--- With @n = 'Z'@, the generator looks for a simple nullary constructor.  If none
--- exist at the current type, as is the case for our @Tree@ type, it carries on
--- as in 'genericArbitraryFrequency'.
---
--- > genericArbitraryFrequency' Z :: Arbitrary a => [Int] -> Gen (Tree a)
--- > genericArbitraryFrequency' Z [x, y] =
--- >   frequency
--- >     [ (x, Leaf <$> arbitrary)
--- >     , (y, scale (`div` 2) $ Node <$> arbitrary <*> arbitrary)
--- >     ]
--- >     -- 2 because Node is 2-ary.
---
--- Here is another example:
---
--- > data Tree' = Leaf1 | Leaf2 | Node3 Tree' Tree' Tree'
--- >   deriving Generic
--- >
--- > instance Arbitrary Tree' where
--- >   arbitrary = genericArbitraryFrequency' Z [1, 2, 3]
---
--- 'genericArbitraryFrequency'' is equivalent to:
---
--- > genericArbitraryFrequency' Z :: [Int] -> Gen Tree'
--- > genericArbitraryFrequency' Z [x, y, z] =
--- >   sized $ \n ->
--- >     if n == 0 then
--- >       -- If the size parameter is zero, the non-nullary alternative is discarded.
--- >       frequency $
--- >         [ (x, return Leaf1)
--- >         , (y, return Leaf2)
--- >         ]
--- >     else
--- >       frequency $
--- >         [ (x, return Leaf1)
--- >         , (y, return Leaf2)
--- >         , (z, resize (n `div` 3) node)
--- >         ]
--- >         -- 3 because Node3 is 3-ary
--- >   where
--- >     node = Node3 <$> arbitrary <*> arbitrary <*> arbitrary
---
--- To increase the chances of termination when no nullary constructor is directly
--- available, such as in @Tree@, we can pass a larger depth @n@. The effectiveness
--- of this parameter depends on the concrete type the generator is used for.
---
--- For instance, if we want to generate a value of type @Tree ()@, there is a
--- value of depth 1 (represented by @'S' 'Z'@) that we can use to end
--- recursion: @Leaf ()@.
---
--- > genericArbitraryFrequency' (S Z) :: [Int] -> Gen (Tree ())
--- > genericArbitraryFrequency' (S Z) [x, y] =
--- >   sized $ \n ->
--- >     if n == 0 then
--- >       return (Leaf ())
--- >     else
--- >       frequency
--- >         [ (x, Leaf <$> arbitrary)
--- >         , (y, scale (`div` 2) $ Node <$> arbitrary <*> arbitrary)
--- >         ]
+-- | Trees of weights assigned to constructors of type @a@,
+-- rescaled to obtain a probability distribution.
 --
--- Because the argument of @Tree@ must be inspected in order to discover
--- values of type @Tree ()@, we incur some extra constraints if we want
--- polymorphism.
+-- Two ways of constructing them.
 --
--- @FlexibleContexts@ and @UndecidableInstances@ are also required.
+-- @
+-- 'weights' (x1 '%' x2 '%' ... '%' xn '%' ()) :: 'Weights' a
+-- 'uniform' :: 'Weights' a
+-- @
 --
--- > instance (Arbitrary a, Generic a, BaseCases Z (Rep a))
--- >   => Arbitrary (Tree a) where
--- >   arbitrary = genericArbitraryFrequency' (S Z) [1, 2]
+-- Using @weights@, there must be exactly as many weights as
+-- there are constructors.
 --
--- A synonym is provided for brevity.
+-- 'uniform' is equivalent to @'weights' (1 '%' ... '%' 1 '%' ())@
+-- (automatically fills out the right number of 1s).
+data Weights a = Weights (Weights_ (Rep a)) Int
+
+-- | Type of a single weight, tagged with the name of the associated
+-- constructor for additional compile-time checking.
 --
--- > instance (Arbitrary a, BaseCases' Z a) => Arbitrary (Tree a) where
--- >   arbitrary = genericArbitraryFrequency' (S Z) [1, 2]
+-- @
+-- 'weights' ((9 :: 'W' \"Leaf\") '%' (8 :: 'W' \"Node\") '%' ())
+-- @
+newtype W (c :: Symbol) = W Int deriving Num
 
-genericArbitraryFrequency'
-  :: forall n a
-  . (Generic a, GA (Sized n) (Rep a))
-  => n
-  -> [Int]  -- ^ List of weights for every constructor
-  -> Gen a
-genericArbitraryFrequency' _ =
-  (unFreq . fmap to) (ga :: Freq (Sized n) (Rep a p))
+-- | A smart constructor to specify a custom distribution.
+weights :: (Weights_ (Rep a), Int, ()) -> Weights a
+weights (w, n, ()) = Weights w n
 
+-- | Uniform distribution.
+uniform :: UniformWeight (Weights_ (Rep a)) => Weights a
+uniform =
+  let (w, n) = uniformWeight
+  in Weights w n
 
--- | Like 'genericArbitraryFrequency'', but with uniformly distributed
--- constructors.
+type family First a :: Symbol where
+  First (a :| _b) = First a
+  First (L c) = c
 
-genericArbitrary'
-  :: forall n a
-  . (Generic a, GA (Sized n) (Rep a)) => n -> Gen a
-genericArbitrary' _ =
-  (($ repeat 1) . unFreq . fmap to) (ga :: Freq (Sized n) (Rep a p))
+class WeightBuilder a where
+  type Prec a r
 
+  -- | A binary constructor for building up trees of weights.
+  (%) :: W (First a) -> Prec a r -> (a, Int, r)
 
--- * Internal
+infixr 1 %
 
-newtype Freq sized a = Freq { unFreq :: [Int] -> Gen a }
-  deriving Functor
+instance WeightBuilder a => WeightBuilder (a :| b) where
+  type Prec (a :| b) r = Prec a (b, Int, r)
+  m % prec =
+    let (a, n, (b, p, r)) = m % prec
+    in (N a n b, n + p, r)
 
-instance Applicative (Freq sized) where
-  pure = Freq . pure . pure
-  Freq f <*> Freq x = Freq (liftA2 (<*>) f x)
+instance WeightBuilder (L c) where
+  type Prec (L c) r = r
+  W m % prec = (L, m, prec)
 
+class UniformWeight a where
+  uniformWeight :: (a, Int)
+
+instance (UniformWeight a, UniformWeight b) => UniformWeight (a :| b) where
+  uniformWeight =
+    let
+      (a, m) = uniformWeight
+      (b, n) = uniformWeight
+    in
+      (N a m b, m + n)
+
+instance UniformWeight (L c) where
+  uniformWeight = (L, 1)
+
 newtype Gen' sized a = Gen' { unGen' :: Gen a }
-  deriving (Functor, Applicative)
+  deriving (Functor, Applicative, Monad)
 
 data Sized n
 data Unsized
 
-liftGen :: Gen a -> Freq sized a
-liftGen = Freq . const
+sized' :: (Int -> Gen' sized a) -> Gen' sized a
+sized' g = Gen' . sized $ \sz -> unGen' (g sz)
 
 -- | Generic Arbitrary
 class GA sized f where
-  ga :: Freq sized (f p)
+  ga :: Weights_ f -> Int -> Gen' sized (f p)
 
-instance GA sized U1 where
-  ga = pure U1
+instance GA sized f => GA sized (M1 D c f) where
+  ga w n = fmap M1 (ga w n)
 
-instance Arbitrary c => GA sized (K1 i c) where
-  ga = liftGen . fmap K1 $ arbitrary
+instance GAProduct f => GA Unsized (M1 C c f) where
+  ga _ _ = (Gen' . fmap M1) gaProduct
 
-instance GA sized f => GA sized (M1 i c f) where
-  ga = fmap M1 ga
+instance (GAProduct f, KnownNat (Arity f)) => GA (Sized n) (M1 C c f) where
+  ga _ _ = Gen' (scale (`div` arity) gaProduct)
+    where
+      arity = fromInteger (natVal' (proxy# :: Proxy# (Arity f)))
 
 instance (GASum (Sized n) f, GASum (Sized n) g, BaseCases n f, BaseCases n g)
   => GA (Sized n) (f :+: g) where
-  ga = frequency' gaSum baseCases
-    where
-      frequency' :: [Gen' sized a] -> Tagged n [[a]] -> Freq sized a
-      frequency' as (Tagged a0s) = Freq $ \ws ->
-        let
-          units = [(w, elements a0) | (w, a0@(_ : _)) <- zip ws a0s]
-        in
-          sized $ \sz -> frequency $
-            if sz == 0 && not (null units) then
-              units
-            else
-              [(w, a) | (w, Gen' a) <- zip ws as]
+  ga w n = sized' $ \sz ->
+    case unTagged (baseCases w n :: Tagged n (Weighted ((f :+: g) p))) of
+      Weighted (Just (bc, n)) | sz == 0 -> Gen' (choose (0, n - 1) >>= bc)
+      _ -> gaSum' w n
 
 instance (GASum Unsized f, GASum Unsized g) => GA Unsized (f :+: g) where
-  ga = frequency' gaSum
-    where
-      frequency' :: [Gen' sized a] -> Freq sized a
-      frequency' as = Freq $ \ws -> frequency
-        [(w, a) | (w, Gen' a) <- zip ws as]
-
-instance (GA Unsized f, GA Unsized g) => GA Unsized (f :*: g) where
-  ga = liftA2 (:*:) ga ga
-
-instance (GAProduct f, GAProduct g) => GA (Sized n) (f :*: g) where
-  ga = constScale' a
-    where
-      constScale' :: Gen' Unsized a -> Freq (Sized n) a
-      constScale' = Freq . const . scale (`div` arity) . unGen'
-      (arity, a) = gaProduct
-
+  ga = gaSum'
 
-gArbitrarySingle :: forall sized f p . GA sized f => Gen' sized (f p)
-gArbitrarySingle = Gen' (unFreq (ga :: Freq sized (f p)) [1])
+gArbitrarySingle
+  :: forall sized f p c0
+  .  (GA sized f, Weights_ f ~ L c0)
+  => Gen' sized (f p)
+gArbitrarySingle = ga L 0
 
+gaSum' :: GASum sized f => Weights_ f -> Int -> Gen' sized (f p)
+gaSum' w n = do
+  i <- Gen' $ choose (0, n-1)
+  gaSum i w
 
 class GASum sized f where
-  gaSum :: [Gen' sized (f p)]
+  gaSum :: Int -> Weights_ f -> Gen' sized (f p)
 
 instance (GASum sized f, GASum sized g) => GASum sized (f :+: g) where
-  gaSum = (fmap . fmap) L1 gaSum ++ (fmap . fmap) R1 gaSum
+  gaSum i (N a n b)
+    | i < n = fmap L1 (gaSum i a)
+    | otherwise = fmap R1 (gaSum (i - n) b)
 
-instance GA sized f => GASum sized (M1 i c f) where
-  gaSum = [gArbitrarySingle]
+instance GAProduct f => GASum sized (M1 i c f) where
+  gaSum _ _ = Gen' gaProduct
 
 
 class GAProduct f where
-  gaProduct :: (Int, Gen' Unsized (f p))
+  gaProduct :: Gen (f p)
 
-instance GA Unsized f => GAProduct (M1 i c f) where
-  gaProduct = (1, gArbitrarySingle)
+instance GAProduct U1 where
+  gaProduct = pure U1
 
+instance Arbitrary c => GAProduct (K1 i c) where
+  gaProduct = fmap K1 arbitrary
+
+instance GAProduct f => GAProduct (M1 i c f) where
+  gaProduct = fmap M1 gaProduct
+
 instance (GAProduct f, GAProduct g) => GAProduct (f :*: g) where
-  gaProduct = (m + n, liftA2 (:*:) a b)
-    where
-      (m, a) = gaProduct
-      (n, b) = gaProduct
+  gaProduct = liftA2 (:*:) gaProduct gaProduct
 
+type family Arity f :: Nat where
+  Arity (f :*: g) = Arity f + Arity g
+  Arity (M1 _i _c _f) = 1
 
+
 newtype Tagged a b = Tagged { unTagged :: b }
+  deriving Functor
 
 -- $nat
 -- Use the 'Z' and 'S' data types to define the depths of values used
--- by 'genericArbitraryFrequency'' and 'genericArbitrary'' to make
--- generators terminate.
+-- by 'genericArbitrary'' to make generators terminate.
 
 -- | Zero
 data Z = Z
@@ -261,38 +214,87 @@
 -- | Successor
 data S n = S n
 
--- | A @BaseCases n ('Rep' a)@ constraint basically provides the list of values
--- of type @a@ with depth at most @n@.
+newtype Weighted a = Weighted (Maybe (Int -> Gen a, Int))
+  deriving Functor
+
+instance Applicative Weighted where
+  pure a = Weighted (Just ((pure . pure) a, 1))
+  Weighted f <*> Weighted a = Weighted $ liftA2 g f a
+    where
+      g (f, m) (a, n) =
+        ( \i ->
+            let (j, k) = i `divMod` m
+            in f j <*> a k
+        , m * n )
+
+instance Alternative Weighted where
+  empty = Weighted Nothing
+  a <|> Weighted Nothing = a
+  Weighted Nothing <|> b = b
+  Weighted (Just (a, m)) <|> Weighted (Just (b, n)) = Weighted . Just $
+    ( \i ->
+        if i < m then
+          a i
+        else
+          b (i - m)
+    , m + n )
+
 class BaseCases n f where
-  baseCases :: Tagged n [[f p]]
+  baseCases :: Weights_ f -> Int -> Tagged n (Weighted (f p))
 
--- | For convenience.
-type BaseCases' n a = (Generic a, BaseCases n (Rep a))
+instance (BaseCases n f, BaseCases n g) => BaseCases n (f :+: g) where
+  baseCases (N a m b) n =
+    concat
+      ((fmap . fmap) L1 (baseCases a m))
+      ((fmap . fmap) R1 (baseCases b (n - m)))
+    where
+      concat :: Alternative u => Tagged n (u a) -> Tagged n (u a) -> Tagged n (u a)
+      concat (Tagged a) (Tagged b) = Tagged (a <|> b)
 
-baseCases' :: forall n f p. BaseCases n f => Tagged n [f p]
-baseCases' = (Tagged . concat . unTagged) (baseCases :: Tagged n [[f p]])
+instance ListBaseCases n f => BaseCases n (M1 i c f) where
+  baseCases _ n = fmap reweigh listBaseCases
+    where
+      reweigh :: Weighted a -> Weighted a
+      reweigh (Weighted h) = Weighted (fmap (\(g, _) -> (g, n)) h)
 
-instance BaseCases n U1 where
-  baseCases = Tagged [[U1]]
+-- | A @ListBaseCases n ('Rep' a)@ constraint basically provides the list of
+-- values of type @a@ with depth at most @n@.
+class ListBaseCases n f where
+  listBaseCases :: Alternative u => Tagged n (u (f p))
 
-instance BaseCases n f => BaseCases n (M1 i c f) where
-  baseCases = (coerce :: Tagged n [[f p]] -> Tagged n [[M1 i c f p]]) baseCases
+-- | For convenience.
+type BaseCases' n a = (Generic a, ListBaseCases n (Rep a))
 
-instance BaseCases Z (K1 i c) where
-  baseCases = Tagged [[]]
+instance ListBaseCases n U1 where
+  listBaseCases = Tagged (pure U1)
 
-instance (Generic c, BaseCases n (Rep c)) => BaseCases (S n) (K1 i c) where
-  baseCases =
-    (Tagged . (fmap . fmap) (K1 . to) . unTagged)
-      (baseCases :: Tagged n [[Rep c p]])
+instance ListBaseCases n f => ListBaseCases n (M1 i c f) where
+  listBaseCases = (fmap . fmap) M1 listBaseCases
 
-instance (BaseCases n f, BaseCases n g) => BaseCases n (f :+: g) where
-  baseCases = Tagged $
-    ((fmap . fmap) L1 . unTagged) (baseCases :: Tagged n [[f p]]) ++
-    ((fmap . fmap) R1 . unTagged) (baseCases :: Tagged n [[g p]])
+instance ListBaseCases Z (K1 i c) where
+  listBaseCases = Tagged empty
 
-instance (BaseCases n f, BaseCases n g) => BaseCases n (f :*: g) where
-  baseCases = Tagged
-    [ liftA2 (:*:)
-        (unTagged (baseCases' :: Tagged n [f p]))
-        (unTagged (baseCases' :: Tagged n [g p])) ]
+instance (Generic c, ListBaseCases n (Rep c)) => ListBaseCases (S n) (K1 i c) where
+  listBaseCases = (retag . (fmap . fmap) (K1 . to)) listBaseCases
+    where
+      retag :: Tagged n a -> Tagged (S n) a
+      retag = coerce
+
+instance (ListBaseCases n f, ListBaseCases n g) => ListBaseCases n (f :+: g) where
+  listBaseCases =
+    concat
+      ((fmap . fmap) L1 listBaseCases)
+      ((fmap . fmap) R1 listBaseCases)
+    where
+      concat :: Alternative u => Tagged n (u a) -> Tagged n (u a) -> Tagged n (u a)
+      concat (Tagged a) (Tagged b) = Tagged (a <|> b)
+
+instance (ListBaseCases n f, ListBaseCases n g) => ListBaseCases n (f :*: g) where
+  listBaseCases = liftedP listBaseCases listBaseCases
+    where
+      liftedP
+        :: Applicative u
+        => Tagged n (u (f p))
+        -> Tagged n (u (g p))
+        -> Tagged n (u ((f :*: g) p))
+      liftedP (Tagged f) (Tagged g) = Tagged (liftA2 (:*:) f g)
diff --git a/test/Test/Tree.hs b/test/Test/Tree.hs
--- a/test/Test/Tree.hs
+++ b/test/Test/Tree.hs
@@ -16,4 +16,4 @@
 size L = 0
 
 instance Arbitrary T where
-  arbitrary = genericArbitraryFrequency [9, 8]
+  arbitrary = genericArbitrary (weights (9 % 8 % ()))
diff --git a/test/tree.hs b/test/tree.hs
--- a/test/tree.hs
+++ b/test/tree.hs
@@ -1,3 +1,7 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+
 import Control.Monad
 import Data.Data
 import Data.Foldable
@@ -6,6 +10,8 @@
 import System.Exit
 import System.IO
 
+import Options.Generic
+
 import Generic.Random.Data
 import Generic.Random.Internal.Data
 
@@ -23,10 +29,14 @@
     when (x `mod` 1000 == 0) $ putStr "." >> hFlush stdout
   gen
 
+-- | Invocation: stack test [--test-arguments TEST_SIZE]
+type Input = Maybe (Int <?> "Test size")
+
 main = do
+  n_ <- getRecord "Test program" :: IO Input
   success <- newIORef True
 
-  let n = 64
+  let n = maybe 10 unHelpful n_
       range = tolerance epsilon n
 
   for_