diff --git a/QuickCheck.cabal b/QuickCheck.cabal
--- a/QuickCheck.cabal
+++ b/QuickCheck.cabal
@@ -1,12 +1,12 @@
 Name: QuickCheck
-Version: 2.1.0.1
+Version: 2.1.0.2
 Cabal-Version: >= 1.2
 Build-type: Simple
 License: BSD3
 License-file: LICENSE
 Copyright: Koen Claessen <koen@chalmers.se>
 Author: Koen Claessen <koen@chalmers.se>
-Maintainer: Koen Claessen <koen@chalmers.se>
+Maintainer: QuickCheck developers <quickcheck@projects.haskell.org>
 Homepage: http://www.cs.chalmers.se/~koen
 Category:	    Testing
 Synopsis:	    Automatic testing of Haskell programs
@@ -27,18 +27,25 @@
 flag splitBase
   Description: Choose the new smaller, split-up base package.
 
+flag extensibleExceptions
+  Description: Choose the even newer, even smaller, split-up base package.
+
 library
   Build-depends: mtl
-  if flag(splitBase)
-    Build-depends: base >= 3, random
+  if flag(extensibleExceptions)
+    Build-depends: base >= 4 && < 5, random
   else
-    Build-depends: base < 3
+    if flag(splitBase)
+      Build-depends: base >= 3 && < 4, random
+    else
+      Build-depends: base < 3
   Exposed-Modules:
     Test.QuickCheck,
     Test.QuickCheck.Arbitrary,
     Test.QuickCheck.Function,
     Test.QuickCheck.Gen,
     Test.QuickCheck.Monadic,
+    Test.QuickCheck.Modifiers,
     Test.QuickCheck.Property,
     Test.QuickCheck.Test,
     Test.QuickCheck.Text,
diff --git a/Test/QuickCheck.hs b/Test/QuickCheck.hs
--- a/Test/QuickCheck.hs
+++ b/Test/QuickCheck.hs
@@ -60,6 +60,7 @@
   , NonZero(..)
   , NonNegative(..)
   , Smart(..)
+  , Shrink2(..)
   , Shrinking(..)
   , ShrinkState(..)
 
@@ -94,6 +95,7 @@
 
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Arbitrary
+import Test.QuickCheck.Modifiers
 import Test.QuickCheck.Property hiding ( Result(..) )
 import Test.QuickCheck.Test
 import Test.QuickCheck.Text
diff --git a/Test/QuickCheck/Arbitrary.hs b/Test/QuickCheck/Arbitrary.hs
--- a/Test/QuickCheck/Arbitrary.hs
+++ b/Test/QuickCheck/Arbitrary.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS -fglasgow-exts #-}
 module Test.QuickCheck.Arbitrary
   ( 
   -- * Arbitrary and CoArbitrary classes.
@@ -12,6 +11,7 @@
   , arbitraryBoundedRandom   -- :: (Bounded a, Random a) => Gen a
   -- ** Helper functions for implementing shrink
   , shrinkNothing            -- :: a -> [a]
+  , shrinkList               -- :: (a -> [a]) -> [a] -> [[a]]
   , shrinkIntegral           -- :: Integral a => a -> [a]
   , shrinkRealFrac           -- :: RealFrac a => a -> [a]
   -- ** Helper functions for implementing coarbitrary
@@ -23,18 +23,6 @@
   -- ** Generators which use arbitrary
   , vector      -- :: Arbitrary a => Int -> Gen [a]
   , orderedList -- :: (Ord a, Arbitrary a) => Gen [a]
-
-  -- ** Type-level modifiers for changing generator behavior
-  , Blind(..)
-  , Fixed(..)
-  , OrderedList(..)
-  , NonEmptyList(..)
-  , Positive(..)
-  , NonZero(..)
-  , NonNegative(..)
-  , Smart(..)
-  , Shrinking(..)
-  , ShrinkState(..)
   )
  where
 
@@ -55,6 +43,10 @@
   ( chr
   , ord
   , isLower
+  , isUpper
+  , toLower
+  , isDigit
+  , isSpace
   )
 
 import Data.Ratio
@@ -123,32 +115,34 @@
     do k <- choose (0,n)
        sequence [ arbitrary | _ <- [1..k] ]
 
-  shrink xs = removeChunks xs
-           ++ shrinkOne xs
+  shrink xs = shrinkList shrink xs
+
+shrinkList :: (a -> [a]) -> [a] -> [[a]]
+shrinkList shr xs = removeChunks xs ++ shrinkOne xs
+ where
+  removeChunks xs = rem (length xs) xs
    where
-    removeChunks xs = rem (length xs) xs
+    rem 0 _  = []
+    rem 1 _  = [[]]
+    rem n xs = xs1
+             : xs2
+             : ( [ xs1' ++ xs2 | xs1' <- rem n1 xs1, not (null xs1') ]
+           `ilv` [ xs1 ++ xs2' | xs2' <- rem n2 xs2, not (null xs2') ]
+               )
      where
-      rem 0 _  = []
-      rem 1 _  = [[]]
-      rem n xs = xs1
-               : xs2
-               : ( [ xs1' ++ xs2 | xs1' <- rem n1 xs1, not (null xs1') ]
-             `ilv` [ xs1 ++ xs2' | xs2' <- rem n2 xs2, not (null xs2') ]
-                 )
-       where
-        n1  = n `div` 2
-        xs1 = take n1 xs
-        n2  = n - n1
-        xs2 = drop n1 xs
-    
-        []     `ilv` ys     = ys
-        xs     `ilv` []     = xs
-        (x:xs) `ilv` (y:ys) = x : y : (xs `ilv` ys)
-    
-    shrinkOne []     = []
-    shrinkOne (x:xs) = [ x':xs | x'  <- shrink x ]
-                    ++ [ x:xs' | xs' <- shrinkOne xs ] 
+      n1  = n `div` 2
+      xs1 = take n1 xs
+      n2  = n - n1
+      xs2 = drop n1 xs
 
+      []     `ilv` ys     = ys
+      xs     `ilv` []     = xs
+      (x:xs) `ilv` (y:ys) = x : y : (xs `ilv` ys)
+
+  shrinkOne []     = []
+  shrinkOne (x:xs) = [ x':xs | x'  <- shr x ]
+                  ++ [ x:xs' | xs' <- shrinkOne xs ] 
+
 {-
   -- "standard" definition for lists:
   shrink []     = []
@@ -212,8 +206,22 @@
 
 instance Arbitrary Char where
   arbitrary = chr `fmap` oneof [choose (0,127), choose (0,255)]
-  shrink c  = [ c' | c' <- ['a','b','c'], c' < c || not (isLower c) ]
-
+  shrink c  = filter (<. c) $ nub
+            $ ['a','b','c']
+           ++ [ toLower c | isUpper c ]
+           ++ ['A','B','C']
+           ++ ['1','2','3']
+           ++ [' ','\n']
+   where
+    a <. b  = stamp a < stamp b
+    stamp a = ( not (isLower a)
+              , not (isUpper a)
+              , not (isDigit a)
+              , not (a==' ')
+              , not (isSpace a)
+              , a
+              )
+    
 instance Arbitrary Float where
   arbitrary = arbitrarySizedFractional
   shrink    = shrinkRealFrac
@@ -433,181 +441,6 @@
 -- | Generates an ordered list of a given length.
 orderedList :: (Ord a, Arbitrary a) => Gen [a]
 orderedList = sort `fmap` arbitrary
-
---------------------------------------------------------------------------
--- ** arbitrary modifiers
-
--- These datatypes are mainly here to *pattern match* on in properties.
--- This is a stylistic alternative to using explicit quantification.
--- In other words, they should not be replaced by type synonyms, and their
--- constructors should be exported.
-
--- Examples:
-{-
-prop_TakeDropWhile (Blind p) (xs :: [A]) =           -- because functions cannot be shown
-  takeWhile p xs ++ dropWhile p xs == xs
-
-prop_TakeDrop (NonNegative n) (xs :: [A]) =          -- (BTW, also works for negative n)
-  take n xs ++ drop n xs == xs
-
-prop_Cycle (NonNegative n) (NonEmpty (xs :: [A])) =  -- cycle does not work for empty lists
-  take n (cycle xs) == take n (xs ++ cycle xs)
-
-prop_Sort (Ordered (xs :: [OrdA])) =                 -- instead of "forAll orderedList"
-  sort xs == xs
--}
-
--- | @Blind x@: as x, but x does not have to be in the 'Show' class.
-newtype Blind a = Blind a
- deriving ( Eq, Ord, Num, Integral, Real, Enum )
-
-instance Show (Blind a) where
-  show _ = "(*)"
-
-instance Arbitrary a => Arbitrary (Blind a) where
-  arbitrary = Blind `fmap` arbitrary
-
-  shrink (Blind x) = [ Blind x' | x' <- shrink x ]
-
--- | @Fixed x@: as x, but will not be shrunk.
-newtype Fixed a = Fixed a
- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
-
-instance Arbitrary a => Arbitrary (Fixed a) where
-  arbitrary = Fixed `fmap` arbitrary
-  
-  -- no shrink function
-
--- | @Ordered xs@: guarantees that xs is ordered.
-newtype OrderedList a = Ordered [a]
- deriving ( Eq, Ord, Show, Read )
-
-instance (Ord a, Arbitrary a) => Arbitrary (OrderedList a) where
-  arbitrary = Ordered `fmap` orderedList
-
-  shrink (Ordered xs) =
-    [ Ordered xs'
-    | xs' <- shrink xs
-    , sort xs' == xs'
-    ]
-
--- | @NonEmpty xs@: guarantees that xs is non-empty.
-newtype NonEmptyList a = NonEmpty [a]
- deriving ( Eq, Ord, Show, Read )
-
-instance Arbitrary a => Arbitrary (NonEmptyList a) where
-  arbitrary = NonEmpty `fmap` (arbitrary `suchThat` (not . null))
-
-  shrink (NonEmpty xs) =
-    [ NonEmpty xs'
-    | xs' <- shrink xs
-    , not (null xs')
-    ]
-
--- | @Positive x@: guarantees that @x \> 0@.
-newtype Positive a = Positive a
- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
-
-instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where
-  arbitrary =
-    (Positive . abs) `fmap` (arbitrary `suchThat` (/= 0))
-
-  shrink (Positive x) =
-    [ Positive x'
-    | x' <- shrink x
-    , x' > 0
-    ]
-
--- | @NonZero x@: guarantees that @x \/= 0@.
-newtype NonZero a = NonZero a
- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
-
-instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonZero a) where
-  arbitrary = fmap NonZero $ arbitrary `suchThat` (/= 0)
-
-  shrink (NonZero x) = [ NonZero x' | x' <- shrink x, x' /= 0 ]
-
--- | @NonNegative x@: guarantees that @x \>= 0@.
-newtype NonNegative a = NonNegative a
- deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
-
-instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where
-  arbitrary =
-    frequency
-      -- why is this distrbution like this?
-      [ (5, (NonNegative . abs) `fmap` arbitrary)
-      , (1, return 0)
-      ]
-
-  shrink (NonNegative x) =
-    [ NonNegative x'
-    | x' <- shrink x
-    , x' >= 0
-    ]
-
--- | @Smart _ x@: tries a different order when shrinking.
-data Smart a =
-  Smart Int a
-
-instance Show a => Show (Smart a) where
-  showsPrec n (Smart _ x) = showsPrec n x
-
-instance Arbitrary a => Arbitrary (Smart a) where
-  arbitrary =
-    do x <- arbitrary
-       return (Smart 0 x)
-
-  shrink (Smart i x) = take i' ys `ilv` drop i' ys
-   where
-    ys = [ Smart i y | (i,y) <- [0..] `zip` shrink x ]
-    i' = 0 `max` (i-2)
-
-    []     `ilv` bs     = bs
-    as     `ilv` []     = as
-    (a:as) `ilv` (b:bs) = a : b : (as `ilv` bs)
-    
-{-
-  shrink (Smart i x) = part0 ++ part2 ++ part1
-   where
-    ys = [ Smart i y | (i,y) <- [0..] `zip` shrink x ]
-    i' = 0 `max` (i-2)
-    k  = i `div` 10
-    
-    part0 = take k ys
-    part1 = take (i'-k) (drop k ys)
-    part2 = drop i' ys
--}
-
-    -- drop a (drop b xs) == drop (a+b) xs           | a,b >= 0
-    -- take a (take b xs) == take (a `min` b) xs
-    -- take a xs ++ drop a xs == xs
-    
-    --    take k ys ++ take (i'-k) (drop k ys) ++ drop i' ys
-    -- == take k ys ++ take (i'-k) (drop k ys) ++ drop (i'-k) (drop k ys)
-    -- == take k ys ++ take (i'-k) (drop k ys) ++ drop (i'-k) (drop k ys)
-    -- == take k ys ++ drop k ys
-    -- == ys
-
--- | @Shrinking _ x@: allows for maintaining a state during shrinking.
-data Shrinking s a =
-  Shrinking s a
-
-class ShrinkState s a where
-  shrinkInit  :: a -> s
-  shrinkState :: a -> s -> [(a,s)]
-
-instance Show a => Show (Shrinking s a) where
-  showsPrec n (Shrinking _ x) = showsPrec n x
-
-instance (Arbitrary a, ShrinkState s a) => Arbitrary (Shrinking s a) where
-  arbitrary =
-    do x <- arbitrary
-       return (Shrinking (shrinkInit x) x)
-
-  shrink (Shrinking s x) =
-    [ Shrinking s' x'
-    | (x',s') <- shrinkState x s
-    ]
 
 --------------------------------------------------------------------------
 -- the end.
diff --git a/Test/QuickCheck/Exception.hs b/Test/QuickCheck/Exception.hs
--- a/Test/QuickCheck/Exception.hs
+++ b/Test/QuickCheck/Exception.hs
@@ -1,18 +1,29 @@
+{-# LANGUAGE CPP #-}
 module Test.QuickCheck.Exception where
 
+#if defined(MIN_VERSION_base)
+#if !(MIN_VERSION_base(4,0,0))
+#define SomeException Exception
+#endif
+#endif
+
+#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ < 609)
+#define SomeException Exception
+#endif
+
 import Control.Exception
   ( evaluate
   , try
-  , Exception
+  , SomeException
   )
 
 --------------------------------------------------------------------------
 -- try evaluate
 
-tryEvaluate :: a -> IO (Either Exception a)
+tryEvaluate :: a -> IO (Either SomeException a)
 tryEvaluate x = tryEvaluateIO (return x)
 
-tryEvaluateIO :: IO a -> IO (Either Exception a)
+tryEvaluateIO :: IO a -> IO (Either SomeException a)
 tryEvaluateIO m = try (m >>= evaluate)
 --tryEvaluateIO m = Right `fmap` m
 
diff --git a/Test/QuickCheck/Function.hs b/Test/QuickCheck/Function.hs
--- a/Test/QuickCheck/Function.hs
+++ b/Test/QuickCheck/Function.hs
@@ -1,13 +1,11 @@
--- | Uses magic to show and shrink functions.
+{-# LANGUAGE TypeOperators, GADTs #-}
 module Test.QuickCheck.Function
-  (
-  -- * Magic functions
-    Function(..)
-  , function
-  
-  -- * Generating monotonic functions
-  , MonotonicFunction(..)
-  , StrictlyMonotonicFunction(..)
+  ( Fun(..)
+  , apply
+  , (:->)
+  , FunArbitrary(..)
+  , funArbitraryMap
+  , funArbitraryShow
   )
  where
 
@@ -17,124 +15,243 @@
 import Test.QuickCheck.Gen
 import Test.QuickCheck.Arbitrary
 import Test.QuickCheck.Property
+import Test.QuickCheck.Poly
+import Test.QuickCheck.Modifiers
 
-import Data.IORef
-import Data.List
+import Data.Char
+import Data.Word
 
-import System.IO.Unsafe
-  ( unsafePerformIO -- this is used for the magic
-  )
+--------------------------------------------------------------------------
+-- concrete functions
 
+-- the type of possibly partial concrete functions
+data a :-> c where
+  Pair  :: (a :-> (b :-> c)) -> ((a,b) :-> c)
+  (:+:) :: (a :-> c) -> (b :-> c) -> (Either a b :-> c)
+  Unit  :: c -> (() :-> c)
+  Nil   :: a :-> c
+  Table :: Eq a => [(a,c)] -> (a :-> c)
+  Map   :: (a -> b) -> (b -> a) -> (b :-> c) -> (a :-> c)
+
+instance Functor ((:->) a) where
+  fmap f (Pair p)    = Pair (fmap (fmap f) p)
+  fmap f (p:+:q)     = fmap f p :+: fmap f q
+  fmap f (Unit c)    = Unit (f c)
+  fmap f Nil         = Nil
+  fmap f (Table xys) = Table [ (x,f y) | (x,y) <- xys ]
+  fmap f (Map g h p) = Map g h (fmap f p)
+
+instance (Show a, Show b) => Show (a:->b) where
+  -- only use this on finite functions
+  show p =
+    "{" ++ (case table p of
+             []        -> ""
+             (_,c):xcs -> concat [ show x ++ "->" ++ show c ++ ","
+                                 | (x,c) <- xcs
+                                 ]
+                       ++ "_->" ++ show c)
+        ++ "}"
+   where
+    xcs = table p
+
+-- turning a concrete function into an abstract function (with a default result)
+abstract :: (a :-> c) -> c -> (a -> c)
+abstract (Pair p)    d (x,y) = abstract (fmap (\q -> abstract q d y) p) d x
+abstract (p :+: q)   d exy   = either (abstract p d) (abstract q d) exy
+abstract (Unit c)    _ _     = c
+abstract Nil         d _     = d
+abstract (Table xys) d x     = head ([y | (x',y) <- xys, x == x'] ++ [d])
+abstract (Map g _ p) d x     = abstract p d (g x)
+
+-- generating a table from a concrete function
+table :: (a :-> c) -> [(a,c)]
+table (Pair p)    = [ ((x,y),c) | (x,q) <- table p, (y,c) <- table q ]
+table (p :+: q)   = [ (Left x, c) | (x,c) <- table p ]
+                 ++ [ (Right y,c) | (y,c) <- table q ]
+table (Unit c)    = [ ((), c) ]
+table Nil         = []
+table (Table xys) = xys
+table (Map _ h p) = [ (h x, c) | (x,c) <- table p ]
+
 --------------------------------------------------------------------------
--- | Functions from @a@ to @b@ which keep track of arguments
--- that they are applied to. This allows showing function tables
--- and shrinking functions.
-data Function a b = Function (FunctionTable a b) (a -> b)
+-- FunArbitrary
 
-newtype FunctionTable a b = MkTable (IORef [(a,b)])
+class FunArbitrary a where
+  funArbitrary :: Arbitrary c => Gen (a :-> c)
 
-function :: (a -> b) -> Function a b
-function f =
-  unsafePerformIO $
-    do ref <- newIORef []
-       return $ Function (MkTable ref) $ \x ->
-         unsafePerformIO $
-           let y = f x in
-             do tab <- readIORef ref
-                writeIORef ref ((x,y):tab)
-                return y
+instance (FunArbitrary a, Arbitrary c) => Arbitrary (a :-> c) where
+  arbitrary = funArbitrary
+  shrink    = shrinkFun shrink
 
-getFunction :: Function a b -> (a -> b)
-getFunction (Function _ f) = f
+-- basic instances: pairs, sums, units
 
-getTable :: Function a b -> IO [(a,b)]
-getTable (Function (MkTable ref) _) =
-  do xys <- readIORef ref
-     return (reverse xys)
+instance (FunArbitrary a, FunArbitrary b) => FunArbitrary (a,b) where
+  funArbitrary =
+    do p <- funArbitrary
+       return (Pair p)
 
-showTable :: (Show a, Show b) => [(a,b)] -> String
-showTable xys =
-     "{"
-  ++ concat (intersperse ", " (tabulate (reverse xys)))
-  ++ "}"
- where
-  tabulate = map (\((x,y):_) -> x ++ " -> " ++ y)
-           . groupBy (\(x1,_) (x2,_) -> x1 == x2)
-           . sortBy (\(x1,_) (x2,_) -> x1 `compare` x2)
-           . map (\(x,y) -> (show x, show y))
+instance (FunArbitrary a, FunArbitrary b) => FunArbitrary (Either a b) where
+  funArbitrary =
+    do p <- funArbitrary
+       q <- funArbitrary
+       return (p :+: q)
 
-instance (Show a, Show b) => Show (Function a b) where
-  show fun =
-    unsafePerformIO $
-      do xys <- getTable fun
-         return (showTable xys)
+instance FunArbitrary () where
+  funArbitrary =
+    do c <- arbitrary
+       return (Unit c)
 
-instance (Eq a, CoArbitrary a, Arbitrary b) => Arbitrary (Function a b) where
-  arbitrary =
-    function `fmap` arbitrary
+instance FunArbitrary Word8 where
+  funArbitrary =
+    do xys <- sequence [ do y <- arbitrary
+                            return (x,y)
+                       | x <- [0..255]
+                       ]
+       return (Table xys)
 
-  shrink fun@(Function _ f) =
-    unsafePerformIO $
-      do xys <- getTable fun
-         return [ function (update x y' f)
-                | (x,y) <- xys
-                , y' <- shrink y
-                ]
-     where
-      update x' y' f x
-        | x == x'   = y'
-        | otherwise = f x
+-- other instances (using Map)
 
+funArbitraryMap :: (FunArbitrary a, Arbitrary c) => (b -> a) -> (a -> b) -> Gen (b :-> c)
+funArbitraryMap g h =
+  do p <- funArbitrary
+     return (Map g h p)
+
+funArbitraryShow :: (Show a, Read a, Arbitrary c) => Gen (a :-> c)
+funArbitraryShow = funArbitraryMap show read
+
+instance FunArbitrary a => FunArbitrary [a] where
+  funArbitrary = funArbitraryMap g h
+   where
+    g []     = Left ()
+    g (x:xs) = Right (x,xs)
+
+    h (Left _)       = []
+    h (Right (x,xs)) = x:xs
+
+instance FunArbitrary a => FunArbitrary (Maybe a) where
+  funArbitrary = funArbitraryMap g h
+   where
+    g Nothing  = Left ()
+    g (Just x) = Right x
+
+    h (Left _)  = Nothing
+    h (Right x) = Just x
+
+instance FunArbitrary Bool where
+  funArbitrary = funArbitraryMap g h
+   where
+    g False = Left ()
+    g True  = Right ()
+    
+    h (Left _)  = False
+    h (Right _) = True
+
+instance FunArbitrary Integer where
+  funArbitrary = funArbitraryMap gInteger hInteger
+   where
+    gInteger n | n < 0     = Left (gNatural (abs n - 1))
+               | otherwise = Right (gNatural n)
+    
+    hInteger (Left ws)  = -(hNatural ws + 1)
+    hInteger (Right ws) = hNatural ws
+    
+    gNatural 0 = []
+    gNatural n = (fromIntegral (n `mod` 256) :: Word8) : gNatural (n `div` 256)
+    
+    hNatural []     = 0
+    hNatural (w:ws) = fromIntegral w + 256 * hNatural ws
+
+instance FunArbitrary Int where
+  funArbitrary = funArbitraryMap fromIntegral fromInteger
+
+instance FunArbitrary Char where
+  funArbitrary = funArbitraryMap ord' chr'
+   where
+    ord' c = fromIntegral (ord c) :: Word8
+    chr' n = chr (fromIntegral n)
+
+-- poly instances
+
+instance FunArbitrary A where
+  funArbitrary = funArbitraryMap unA A
+
+instance FunArbitrary B where
+  funArbitrary = funArbitraryMap unB B
+
+instance FunArbitrary C where
+  funArbitrary = funArbitraryMap unC C
+
+instance FunArbitrary OrdA where
+  funArbitrary = funArbitraryMap unOrdA OrdA
+
+instance FunArbitrary OrdB where
+  funArbitrary = funArbitraryMap unOrdB OrdB
+
+instance FunArbitrary OrdC where
+  funArbitrary = funArbitraryMap unOrdC OrdC
+
 --------------------------------------------------------------------------
--- monotonicity
+-- shrinking
 
--- | Monotonic fun: guarantees that fun is monotonic.
-newtype MonotonicFunction = Monotonic (Function Int Int)
- deriving ( Show )
+shrinkFun :: (c -> [c]) -> (a :-> c) -> [a :-> c]
+shrinkFun shr (Pair p) =
+  [ pair p' | p' <- shrinkFun (\q -> shrinkFun shr q) p ]
+ where
+  pair Nil = Nil
+  pair p   = Pair p
 
-instance Arbitrary MonotonicFunction where
-  arbitrary = Monotonic `fmap` arbMonotonicFunction (\(NonNegative x) -> x)
+shrinkFun shr (p :+: q) =
+  [ p .+. Nil | not (isNil q) ] ++
+  [ Nil .+. q | not (isNil p) ] ++
+  [ p' .+. q  | p' <- shrinkFun shr p ] ++
+  [ p  .+. q' | q' <- shrinkFun shr q ]
+ where
+  isNil Nil = True
+  isNil _   = False
+ 
+  Nil .+. Nil = Nil
+  p   .+. q   = p :+: q
 
--- | StrictlyMonotonic fun: guarantees that fun is strictly monotonic.
-newtype StrictlyMonotonicFunction = StrictlyMonotonic (Function Int Int)
- deriving ( Show )
+shrinkFun shr (Unit c) =
+  [ Nil ] ++
+  [ Unit c' | c' <- shr c ]
 
-instance Arbitrary StrictlyMonotonicFunction where
-  arbitrary = StrictlyMonotonic `fmap` arbMonotonicFunction (\(NonZero (NonNegative x)) -> x)
+shrinkFun shr (Table xys) =
+  [ table xys' | xys' <- shrinkList shrXy xys ]
+ where
+  shrXy (x,y) = [(x,y') | y' <- shr y]
+  
+  table []  = Nil
+  table xys = Table xys
 
--- helper functions
+shrinkFun shr Nil =
+  []
 
-arbMonotonicFunction :: Arbitrary a => (a -> Int) -> Gen (Function Int Int)
-arbMonotonicFunction val =
-  do ups   <- arbIncSeq
-     downs <- arbIncSeq
-     y0    <- arbitrary
-     return $ function $ \x ->
-       case x of
-         0             -> y0
-         _ | x > 0     -> y0 + (ups !! (x-1))
-           | otherwise -> y0 - (downs !! (-x-1))
+shrinkFun shr (Map g h p) =
+  [ mapp g h p' | p' <- shrinkFun shr p ]
  where
-  arbIncSeq =
-    do as <- sequence [ arbitrary | _ <- [1..] ]
-       let sums s (x:xs) = s `seq` (s : sums (val x+s) xs)
-       return (tail (sums 0 as))
+  mapp g h Nil = Nil
+  mapp g h p   = Map g h p
 
 --------------------------------------------------------------------------
--- properties
+-- the Fun modifier
 
-prop_Monotonic x y (Monotonic (Function _ f)) =
-  x <= y ==>
-    f x <= f y
+data Fun a b = Fun (a :-> b) (a -> b)
 
-prop_StrictlyMonotonic x y (StrictlyMonotonic (Function _ f)) =
-  x < y ==>
-    f x < f y
+fun :: (a :-> b) -> Fun a b
+fun p = Fun p (abstract p (snd (head (table p))))
 
-prop_StrictlyMonotonic_Wrong x y (Monotonic (Function _ f)) =
-  expectFailure $
-    x < y ==>
-      f x < f y
+apply :: Fun a b -> (a -> b)
+apply (Fun _ f) = f
+
+instance (Show a, Show b) => Show (Fun a b) where
+  show (Fun p _) = show p
+
+instance (FunArbitrary a, Arbitrary b) => Arbitrary (Fun a b) where
+  arbitrary = fun `fmap` arbitrary
+
+  shrink (Fun p _) =
+    [ fun p' | p' <- shrink p, _:_ <- [table p'] ]
 
 --------------------------------------------------------------------------
 -- the end.
diff --git a/Test/QuickCheck/Gen.hs b/Test/QuickCheck/Gen.hs
--- a/Test/QuickCheck/Gen.hs
+++ b/Test/QuickCheck/Gen.hs
@@ -12,8 +12,13 @@
 
 import Control.Monad
   ( liftM
+  , ap
   )
 
+import Control.Applicative
+  ( Applicative(..)
+  )
+
 import Control.Monad.Reader()
   -- needed for "instance Monad (a ->)"
   
@@ -30,6 +35,10 @@
 instance Functor Gen where
   fmap f (MkGen h) =
     MkGen (\r n -> f (h r n))
+
+instance Applicative Gen where
+  pure  = return
+  (<*>) = ap
 
 instance Monad Gen where
   return x =
diff --git a/Test/QuickCheck/Modifiers.hs b/Test/QuickCheck/Modifiers.hs
new file mode 100644
--- /dev/null
+++ b/Test/QuickCheck/Modifiers.hs
@@ -0,0 +1,232 @@
+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
+module Test.QuickCheck.Modifiers
+  (
+  -- ** Type-level modifiers for changing generator behavior
+    Blind(..)
+  , Fixed(..)
+  , OrderedList(..)
+  , NonEmptyList(..)
+  , Positive(..)
+  , NonZero(..)
+  , NonNegative(..)
+  , Smart(..)
+  , Shrink2(..)
+  , Shrinking(..)
+  , ShrinkState(..)
+  )
+ where
+
+--------------------------------------------------------------------------
+-- imports
+
+import Test.QuickCheck.Gen
+import Test.QuickCheck.Arbitrary
+
+import Data.List
+  ( sort
+  )
+
+--------------------------------------------------------------------------
+-- ** arbitrary modifiers
+
+-- These datatypes are mainly here to *pattern match* on in properties.
+-- This is a stylistic alternative to using explicit quantification.
+-- In other words, they should not be replaced by type synonyms, and their
+-- constructors should be exported.
+
+-- Examples:
+{-
+prop_TakeDropWhile (Blind p) (xs :: [A]) =           -- because functions cannot be shown
+  takeWhile p xs ++ dropWhile p xs == xs
+
+prop_TakeDrop (NonNegative n) (xs :: [A]) =          -- (BTW, also works for negative n)
+  take n xs ++ drop n xs == xs
+
+prop_Cycle (NonNegative n) (NonEmpty (xs :: [A])) =  -- cycle does not work for empty lists
+  take n (cycle xs) == take n (xs ++ cycle xs)
+
+prop_Sort (Ordered (xs :: [OrdA])) =                 -- instead of "forAll orderedList"
+  sort xs == xs
+-}
+
+--------------------------------------------------------------------------
+-- | @Blind x@: as x, but x does not have to be in the 'Show' class.
+newtype Blind a = Blind a
+ deriving ( Eq, Ord, Num, Integral, Real, Enum )
+
+instance Show (Blind a) where
+  show _ = "(*)"
+
+instance Arbitrary a => Arbitrary (Blind a) where
+  arbitrary = Blind `fmap` arbitrary
+
+  shrink (Blind x) = [ Blind x' | x' <- shrink x ]
+
+--------------------------------------------------------------------------
+-- | @Fixed x@: as x, but will not be shrunk.
+newtype Fixed a = Fixed a
+ deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
+
+instance Arbitrary a => Arbitrary (Fixed a) where
+  arbitrary = Fixed `fmap` arbitrary
+  
+  -- no shrink function
+
+--------------------------------------------------------------------------
+-- | @Ordered xs@: guarantees that xs is ordered.
+newtype OrderedList a = Ordered [a]
+ deriving ( Eq, Ord, Show, Read )
+
+instance (Ord a, Arbitrary a) => Arbitrary (OrderedList a) where
+  arbitrary = Ordered `fmap` orderedList
+
+  shrink (Ordered xs) =
+    [ Ordered xs'
+    | xs' <- shrink xs
+    , sort xs' == xs'
+    ]
+
+--------------------------------------------------------------------------
+-- | @NonEmpty xs@: guarantees that xs is non-empty.
+newtype NonEmptyList a = NonEmpty [a]
+ deriving ( Eq, Ord, Show, Read )
+
+instance Arbitrary a => Arbitrary (NonEmptyList a) where
+  arbitrary = NonEmpty `fmap` (arbitrary `suchThat` (not . null))
+
+  shrink (NonEmpty xs) =
+    [ NonEmpty xs'
+    | xs' <- shrink xs
+    , not (null xs')
+    ]
+
+--------------------------------------------------------------------------
+-- | @Positive x@: guarantees that @x \> 0@.
+newtype Positive a = Positive a
+ deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
+
+instance (Num a, Ord a, Arbitrary a) => Arbitrary (Positive a) where
+  arbitrary =
+    (Positive . abs) `fmap` (arbitrary `suchThat` (/= 0))
+
+  shrink (Positive x) =
+    [ Positive x'
+    | x' <- shrink x
+    , x' > 0
+    ]
+
+--------------------------------------------------------------------------
+-- | @NonZero x@: guarantees that @x \/= 0@.
+newtype NonZero a = NonZero a
+ deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
+
+instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonZero a) where
+  arbitrary = fmap NonZero $ arbitrary `suchThat` (/= 0)
+
+  shrink (NonZero x) = [ NonZero x' | x' <- shrink x, x' /= 0 ]
+
+--------------------------------------------------------------------------
+-- | @NonNegative x@: guarantees that @x \>= 0@.
+newtype NonNegative a = NonNegative a
+ deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
+
+instance (Num a, Ord a, Arbitrary a) => Arbitrary (NonNegative a) where
+  arbitrary =
+    frequency
+      -- why is this distrbution like this?
+      [ (5, (NonNegative . abs) `fmap` arbitrary)
+      , (1, return 0)
+      ]
+
+  shrink (NonNegative x) =
+    [ NonNegative x'
+    | x' <- shrink x
+    , x' >= 0
+    ]
+
+--------------------------------------------------------------------------
+-- | @Shrink2 x@: allows 2 shrinking steps at the same time when shrinking x
+newtype Shrink2 a = Shrink2 a
+ deriving ( Eq, Ord, Num, Integral, Real, Enum, Show, Read )
+
+instance Arbitrary a => Arbitrary (Shrink2 a) where
+  arbitrary =
+    Shrink2 `fmap` arbitrary
+
+  shrink (Shrink2 x) =
+    [ Shrink2 y | y <- shrink_x ] ++
+    [ Shrink2 z
+    | y <- shrink_x
+    , z <- shrink y
+    ]
+   where
+    shrink_x = shrink x
+
+--------------------------------------------------------------------------
+-- | @Smart _ x@: tries a different order when shrinking.
+data Smart a =
+  Smart Int a
+
+instance Show a => Show (Smart a) where
+  showsPrec n (Smart _ x) = showsPrec n x
+
+instance Arbitrary a => Arbitrary (Smart a) where
+  arbitrary =
+    do x <- arbitrary
+       return (Smart 0 x)
+
+  shrink (Smart i x) = take i' ys `ilv` drop i' ys
+   where
+    ys = [ Smart i y | (i,y) <- [0..] `zip` shrink x ]
+    i' = 0 `max` (i-2)
+
+    []     `ilv` bs     = bs
+    as     `ilv` []     = as
+    (a:as) `ilv` (b:bs) = a : b : (as `ilv` bs)
+    
+{-
+  shrink (Smart i x) = part0 ++ part2 ++ part1
+   where
+    ys = [ Smart i y | (i,y) <- [0..] `zip` shrink x ]
+    i' = 0 `max` (i-2)
+    k  = i `div` 10
+    
+    part0 = take k ys
+    part1 = take (i'-k) (drop k ys)
+    part2 = drop i' ys
+-}
+
+    -- drop a (drop b xs) == drop (a+b) xs           | a,b >= 0
+    -- take a (take b xs) == take (a `min` b) xs
+    -- take a xs ++ drop a xs == xs
+    
+    --    take k ys ++ take (i'-k) (drop k ys) ++ drop i' ys
+    -- == take k ys ++ take (i'-k) (drop k ys) ++ drop (i'-k) (drop k ys)
+    -- == take k ys ++ take (i'-k) (drop k ys) ++ drop (i'-k) (drop k ys)
+    -- == take k ys ++ drop k ys
+    -- == ys
+
+--------------------------------------------------------------------------
+-- | @Shrinking _ x@: allows for maintaining a state during shrinking.
+data Shrinking s a =
+  Shrinking s a
+
+class ShrinkState s a where
+  shrinkInit  :: a -> s
+  shrinkState :: a -> s -> [(a,s)]
+
+instance Show a => Show (Shrinking s a) where
+  showsPrec n (Shrinking _ x) = showsPrec n x
+
+instance (Arbitrary a, ShrinkState s a) => Arbitrary (Shrinking s a) where
+  arbitrary =
+    do x <- arbitrary
+       return (Shrinking (shrinkInit x) x)
+
+  shrink (Shrinking s x) =
+    [ Shrinking s' x'
+    | (x',s') <- shrinkState x s
+    ]
+
+--------------------------------------------------------------------------
+-- the end.
diff --git a/Test/QuickCheck/Monadic.hs b/Test/QuickCheck/Monadic.hs
--- a/Test/QuickCheck/Monadic.hs
+++ b/Test/QuickCheck/Monadic.hs
@@ -1,5 +1,4 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
-
+{-# LANGUAGE Rank2Types #-}
 -- | Allows testing of monadic values.
 module Test.QuickCheck.Monadic where
 
diff --git a/Test/QuickCheck/Poly.hs b/Test/QuickCheck/Poly.hs
--- a/Test/QuickCheck/Poly.hs
+++ b/Test/QuickCheck/Poly.hs
@@ -1,6 +1,6 @@
 module Test.QuickCheck.Poly
-  ( A, B, C
-  , OrdA, OrdB, OrdC
+  ( A(..), B(..), C(..)
+  , OrdA(..), OrdB(..), OrdC(..)
   )
  where
 
@@ -21,8 +21,8 @@
   showsPrec n (A x) = showsPrec n x
 
 instance Arbitrary A where
-  arbitrary    = (A . abs) `fmap` arbitrary
-  shrink (A x) = [ A x' | x' <- shrink x, x >= 0 ]
+  arbitrary    = (A . (+1) . abs) `fmap` arbitrary
+  shrink (A x) = [ A x' | x' <- shrink x, x' > 0 ]
 
 instance CoArbitrary A where
   coarbitrary = coarbitrary . unA
@@ -36,8 +36,8 @@
   showsPrec n (B x) = showsPrec n x
 
 instance Arbitrary B where
-  arbitrary    = (B . abs) `fmap` arbitrary
-  shrink (B x) = [ B x' | x' <- shrink x, x >= 0 ]
+  arbitrary    = (B . (+1) . abs) `fmap` arbitrary
+  shrink (B x) = [ B x' | x' <- shrink x, x' > 0 ]
 
 instance CoArbitrary B where
   coarbitrary = coarbitrary . unB
@@ -51,8 +51,8 @@
   showsPrec n (C x) = showsPrec n x
 
 instance Arbitrary C where
-  arbitrary    = (C . abs) `fmap` arbitrary
-  shrink (C x) = [ C x' | x' <- shrink x, x >= 0 ]
+  arbitrary    = (C . (+1) . abs) `fmap` arbitrary
+  shrink (C x) = [ C x' | x' <- shrink x, x' > 0 ]
 
 instance CoArbitrary C where
   coarbitrary = coarbitrary . unC
@@ -69,8 +69,8 @@
   showsPrec n (OrdA x) = showsPrec n x
 
 instance Arbitrary OrdA where
-  arbitrary       = (OrdA . abs) `fmap` arbitrary
-  shrink (OrdA x) = [ OrdA x' | x' <- shrink x, x >= 0 ]
+  arbitrary       = (OrdA . (+1) . abs) `fmap` arbitrary
+  shrink (OrdA x) = [ OrdA x' | x' <- shrink x, x' > 0 ]
 
 instance CoArbitrary OrdA where
   coarbitrary = coarbitrary . unOrdA
@@ -84,8 +84,8 @@
   showsPrec n (OrdB x) = showsPrec n x
 
 instance Arbitrary OrdB where
-  arbitrary       = (OrdB . abs) `fmap` arbitrary
-  shrink (OrdB x) = [ OrdB x' | x' <- shrink x, x >= 0 ]
+  arbitrary       = (OrdB . (+1) . abs) `fmap` arbitrary
+  shrink (OrdB x) = [ OrdB x' | x' <- shrink x, x' > 0 ]
 
 instance CoArbitrary OrdB where
   coarbitrary = coarbitrary . unOrdB
@@ -99,8 +99,8 @@
   showsPrec n (OrdC x) = showsPrec n x
 
 instance Arbitrary OrdC where
-  arbitrary       = (OrdC . abs) `fmap` arbitrary
-  shrink (OrdC x) = [ OrdC x' | x' <- shrink x, x >= 0 ]
+  arbitrary       = (OrdC . (+1) . abs) `fmap` arbitrary
+  shrink (OrdC x) = [ OrdC x' | x' <- shrink x, x' > 0 ]
 
 instance CoArbitrary OrdC where
   coarbitrary = coarbitrary . unOrdC