diff --git a/src/Data/Generics/Aliases.hs b/src/Data/Generics/Aliases.hs
--- a/src/Data/Generics/Aliases.hs
+++ b/src/Data/Generics/Aliases.hs
@@ -46,12 +46,20 @@
         choiceQ,
 
         -- * Type extension for unary type constructors
+        ext1,
         ext1T,
         ext1M,
         ext1Q,
         ext1R,
-        ext1B
+        ext1B,
 
+        -- * Type extension for binary type constructors
+        ext2T,
+        ext2M,
+        ext2Q,
+        ext2R,
+        ext2B
+
   ) where
 
 #ifdef __HADDOCK__
@@ -304,13 +312,9 @@
 
 
 ------------------------------------------------------------------------------
---
 --      Type extension for unary type constructors
---
 ------------------------------------------------------------------------------
 
-
-
 -- | Flexible type extension
 ext1 :: (Data a, Typeable1 t)
      => c a
@@ -357,6 +361,57 @@
       -> (forall b. Data b => (t b))
       -> a
 ext1B def ext = unB ((B def) `ext1` (B ext))
+
+------------------------------------------------------------------------------
+--      Type extension for binary type constructors
+------------------------------------------------------------------------------
+
+-- | Flexible type extension
+ext2 :: (Data a, Typeable2 t)
+     => c a
+     -> (forall d1 d2. (Data d1, Data d2) => c (t d1 d2))
+     -> c a
+ext2 def ext = maybe def id (dataCast2 ext)
+
+
+-- | Type extension of transformations for unary type constructors
+ext2T :: (Data d, Typeable2 t)
+      => (forall e. Data e => e -> e)
+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> t d1 d2)
+      -> d -> d
+ext2T def ext = unT ((T def) `ext2` (T ext))
+
+
+-- | Type extension of monadic transformations for type constructors
+ext2M :: (Monad m, Data d, Typeable2 t)
+      => (forall e. Data e => e -> m e)
+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> m (t d1 d2))
+      -> d -> m d
+ext2M def ext = unM ((M def) `ext2` (M ext))
+
+
+-- | Type extension of queries for type constructors
+ext2Q :: (Data d, Typeable2 t)
+      => (d -> q)
+      -> (forall d1 d2. (Data d1, Data d2) => t d1 d2 -> q)
+      -> d -> q
+ext2Q def ext = unQ ((Q def) `ext2` (Q ext))
+
+
+-- | Type extension of readers for type constructors
+ext2R :: (Monad m, Data d, Typeable2 t)
+      => m d
+      -> (forall d1 d2. (Data d1, Data d2) => m (t d1 d2))
+      -> m d
+ext2R def ext = unR ((R def) `ext2` (R ext))
+
+
+-- | Type extension of builders for type constructors
+ext2B :: (Data a, Typeable2 t)
+      => a
+      -> (forall d1 d2. (Data d1, Data d2) => (t d1 d2))
+      -> a
+ext2B def ext = unB ((B def) `ext2` (B ext))
 
 ------------------------------------------------------------------------------
 --
diff --git a/src/Data/Generics/Schemes.hs b/src/Data/Generics/Schemes.hs
--- a/src/Data/Generics/Schemes.hs
+++ b/src/Data/Generics/Schemes.hs
@@ -26,6 +26,7 @@
         everywhereM,
         somewhere,
         everything,
+        everythingBut,
         listify,
         something,
         synthesize,
@@ -102,14 +103,18 @@
 -- use gmapQ to recurse into immediate subterms;
 -- use ordinary foldl to reduce list of intermediate results
 -- 
-everything k f x
-  = foldl k (f x) (gmapQ (everything k f) x)
+everything k f x = foldl k (f x) (gmapQ (everything k f) x)
 
+-- | Variation of "everything" with an added stop condition
+everythingBut :: (r -> r -> r) -> GenericQ (r, Bool) -> GenericQ r
+everythingBut k f x = let (v, stop) = f x
+                      in if stop
+                           then v
+                           else foldl k v (gmapQ (everythingBut k f) x)
 
 -- | Get a list of all entities that meet a predicate
 listify :: Typeable r => (r -> Bool) -> GenericQ [r]
-listify p
-  = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
+listify p = everything (++) ([] `mkQ` (\x -> if p x then [x] else []))
 
 
 -- | Look up a subterm by means of a maybe-typed filter
diff --git a/syb.cabal b/syb.cabal
--- a/syb.cabal
+++ b/syb.cabal
@@ -1,5 +1,5 @@
 name:                 syb
-version:              0.2.2
+version:              0.3
 license:              BSD3
 license-file:         LICENSE
 author:               Ralf Lammel, Simon Peyton Jones
@@ -19,7 +19,7 @@
 stability:              provisional
 build-type:             Custom
 cabal-version:          >= 1.6
-tested-with:            GHC == 6.10.4, GHC == 6.12.3, GHC == 7.0.0.20100925
+tested-with:            GHC == 6.10.4, GHC == 6.12.3, GHC == 7.0.1
 
 extra-source-files:     tests/*.hs
 
diff --git a/tests/Ext2.hs b/tests/Ext2.hs
new file mode 100644
--- /dev/null
+++ b/tests/Ext2.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module Ext2 (tests) where
+
+-- Tests for ext2 and friends
+
+import Test.HUnit
+import Data.Generics
+
+
+-- A type of lists
+data List a = Nil | Cons a (List a) deriving (Data, Typeable, Show, Eq)
+
+-- Example lists
+l1, l2 :: List Int
+l1 = Cons 1 (Cons 2 Nil)
+l2 = Cons 0 l1
+
+-- A type of pairs
+data Pair a b = Pair1 a b | Pair2 a b deriving (Data, Typeable, Show, Eq)
+
+-- Example pairs
+p1, p2 :: Pair Int Char
+p1 = Pair1 2 'p'
+p2 = Pair2 3 'q'
+
+-- Structures containing the above
+s1 :: [Pair Int Char]
+s1 = [p1, p2]
+
+s2 :: (Pair Int Char, List Int)
+s2 = (p2, l2)
+
+
+-- Auxiliary functions
+unifyPair :: Pair a b -> Pair a b -> Bool
+unifyPair (Pair1 _ _) (Pair1 _ _) = True
+unifyPair (Pair2 _ _) (Pair2 _ _) = True
+unifyPair _           _           = False
+
+flipPair :: Pair a b -> Pair a b
+flipPair (Pair1 a b) = Pair2 a b
+flipPair (Pair2 a b) = Pair1 a b
+
+-- Tests
+t1 = everywhere (id `ext2T` flipPair) (s1,s2)
+t2 = let f :: (Data a) => a -> Maybe a
+         f = (const Nothing) `ext2M` (Just . flipPair)
+     in (f p1, f l1)
+t3 = everything (+) ( const 0
+             `ext1Q` (const 1  :: List a   -> Int)
+             `ext2Q` (const 10 :: Pair a b -> Int))
+               $ s2
+t4 = unifyPair (t4' :: Pair Int Char) t4' where
+  t4' :: Data a => a
+  t4' = undefined `ext1B` Nil `ext2B` (Pair1 undefined undefined)
+
+
+-- Main function for testing
+tests = (t1, t2, t3, t4) ~=? output
+
+output = ((map flipPair s1, (flipPair p2, l2))
+         ,(Just (flipPair p1),Nothing)
+         ,14
+         ,True)
diff --git a/tests/FoldTree.hs b/tests/FoldTree.hs
--- a/tests/FoldTree.hs
+++ b/tests/FoldTree.hs
@@ -1,4 +1,5 @@
-{-# OPTIONS -fglasgow-exts #-}
+{-# LANGUAGE DeriveDataTypeable  #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 {-
 
@@ -45,19 +46,29 @@
 mytree = Fork (WithWeight (Leaf 42) 1)
               (WithWeight (Fork (Leaf 88) (Leaf 37)) 2)
 
+-- A less typical tree, used for testing everythingBut
+mytree' :: Tree Int Int
+mytree' = Fork (Leaf 42)
+               (WithWeight (Fork (Leaf 88) (Leaf 37)) 2)
 
+
 -- Print everything like an Int in mytree
 -- In fact, we show two attempts:
 --   1. print really just everything like an Int
 --   2. print everything wrapped with Leaf
 -- So (1.) confuses leafs and weights whereas (2.) does not.
--- 
+-- Additionally we test everythingBut, stopping when we see a WithWeight node
 tests = show ( listify (\(_::Int) -> True)         mytree
              , everything (++) ([] `mkQ` fromLeaf) mytree
+             , everythingBut (++) 
+                 (([],False) `mkQ` (\x -> (fromLeaf x, stop x))) mytree'
              ) ~=? output
   where
     fromLeaf :: Tree Int Int -> [Int]
     fromLeaf (Leaf x) = [x]
-    fromLeaf _ = []
+    fromLeaf _        = []
+    stop :: (Data a, Data b) => Tree a b -> Bool
+    stop (WithWeight _ _) = True
+    stop _                = False
 
-output = "([42,1,88,37,2],[42,88,37])"
+output = "([42,1,88,37,2],[42,88,37],[42])"
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -8,6 +8,7 @@
 import qualified Builders
 import qualified Datatype
 import qualified Ext1
+import qualified Ext2
 import qualified FoldTree
 import qualified FreeNames
 import qualified GEq
@@ -70,6 +71,7 @@
            , GenUpTo.tests
            , FreeNames.tests
            , Ext1.tests
+           , Ext2.tests
            , Bits.tests
            , Builders.tests
            ]