Move tests from tests/ghc-regress/* to just tests/*

29 files changed, 1719 insertions, 0 deletions

diff --git a/testsuite/tests/rebindable/DoParamM.hs b/testsuite/tests/rebindable/DoParamM.hs
new file mode 100644
index 0000000000..95ff235cdd
--- /dev/null
+++ b/testsuite/tests/rebindable/DoParamM.hs
@@ -0,0 +1,303 @@
+{-# OPTIONS -XRebindableSyntax #-}
+-- Haskell98!
+
+-- Tests of the do-notation for the parameterized monads
+-- We demonstrate a variable-type state `monadic' transformer
+-- and its phantom-type-state relative to enforce the locking protocol
+-- (a lock can be released only if it is being held, and acquired only
+-- if it is not being held)
+-- The tests are based on the code
+-- http://okmij.org/ftp/Computation/monads.html#param-monad
+
+-- Please search for DO-NOT-YET
+
+module DoParamM where
+
+import Prelude (const, String, ($), (.), Maybe(..), 
+		Int, fromInteger, succ, pred, fromEnum, toEnum, 
+		(+), Char, (==), Bool(..),
+		IO, getLine, putStrLn, read, show)
+import qualified Prelude
+import qualified Control.Monad.State as State
+import qualified Control.Monad.Identity as IdM
+
+-- A parameterized `monad'
+class Monadish m where
+    return :: a -> m p p a
+    fail   :: String -> m p p a
+    (>>=)  :: m p q a -> (a -> m q r b) -> m p r b
+
+m1 >> m2 = m1 >>= (const m2)
+
+-- All regular monads are the instances of the parameterized monad
+
+newtype RegularM m p q a = RegularM{unRM :: m a}
+
+instance Prelude.Monad m => Monadish (RegularM m) where
+    return = RegularM . Prelude.return
+    fail   = RegularM . Prelude.fail
+    m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f))
+
+-- As a warm-up, we write the regular State computation, with the same 
+-- type of state throughout. We thus inject Monad.State into the
+-- parameterized monad
+
+test1 = State.runState (unRM c) (0::Int) where
+         c = gget >>= (\v -> gput (succ v) >> return v)
+         gget :: (State.MonadState s m) => RegularM m s s s
+         gget = RegularM State.get
+         gput :: (State.MonadState s m) => s -> RegularM m s s ()
+         gput = RegularM . State.put
+-- (0,1)
+
+-- The same in the do-notation
+test1_do = State.runState (unRM c) (0::Int) where
+         c = do
+	     v <- gget
+	     gput (succ v)
+	     return v
+         gget :: (State.MonadState s m) => RegularM m s s s
+         gget = RegularM State.get
+         gput :: (State.MonadState s m) => s -> RegularM m s s ()
+         gput = RegularM . State.put
+-- (0,1)
+
+
+-- Introduce the variable-type state (transformer)
+
+newtype VST m si so v = VST{runVST:: si -> m (so,v)}
+
+instance Prelude.Monad m => Monadish (VST m) where
+  return x = VST (\si -> Prelude.return (si,x))
+  fail x   = VST (\si -> Prelude.fail x)
+  m >>= f  = VST (\si -> (Prelude.>>=) (runVST m si) 
+		                       (\ (sm,x) -> runVST (f x) sm))
+
+vsget :: Prelude.Monad m => VST m si si si
+vsget = VST (\si -> Prelude.return (si,si))
+vsput :: Prelude.Monad m => so -> VST m si so ()
+vsput x = VST (\si -> Prelude.return (x,()))
+
+
+-- Repeat test1 via VST: the type of the state is the same
+vsm1 () = vsget >>= (\v -> vsput (succ v) >> return v)
+
+-- The same with the do-notation
+vsm1_do () = do
+	     v <- vsget 
+	     vsput (succ v)
+	     return v
+
+{-
+ *DoParamM> :t vsm1
+ vsm1 :: (Monadish (VST m), IdM.Monad m, Prelude.Enum si) =>
+         () -> VST m si si si
+-}
+
+test2 = IdM.runIdentity (runVST (vsm1 ()) (0::Int))
+-- (1,0)
+
+test2_do = IdM.runIdentity (runVST (vsm1_do ()) (0::Int))
+-- (1,0)
+
+
+-- Now, we vary the type of the state, from Int to a Char
+vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> 
+                           vsget >>= \v' -> return (v,v'))
+
+{-
+ *DoParamM> :t vsm2
+ vsm2 :: (Monadish (VST m), IdM.Monad m) => () -> VST m Int Char (Int, Char)
+-}
+
+-- The same with the do-notation
+ -- the following does not yet work
+vsm2_do () = do
+	     v <- vsget
+             vsput ((toEnum (65+v))::Char)
+             v' <- vsget
+	     return (v,v')
+
+test3 = IdM.runIdentity (runVST (vsm2 ()) (0::Int))
+-- ('A',(0,'A'))
+
+test3_do = IdM.runIdentity (runVST (vsm2_do ()) (0::Int))
+-- ('A',(0,'A'))
+
+{- The following is a deliberate error:
+
+ DoParamM.hs:147:55:
+    Couldn't match expected type `Int' against inferred type `Char'
+    In the second argument of `(==)', namely `v''
+    In the first argument of `return', namely `(v == v')'
+    In the expression: return (v == v')
+
+vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> 
+                           vsget >>= \v' -> return (v==v'))
+ -}
+
+
+ -- The following too must report a type error -- the expression
+--    return (v == v') must be flagged, rather than something else
+vsm3_do () = do
+	     v <- vsget
+             vsput ((toEnum (65+v))::Char)
+             v' <- vsget
+	     return (v==v')
+
+
+
+-- Try polymorphic recursion, over the state.
+-- crec1 invokes itself, and changes the type of the state from
+-- some si to Bool.
+crec1 :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int
+crec1 = vsget >>= (\s1 -> case fromEnum s1 of
+                      0 -> return 0
+                      1 -> vsput (pred s1) >> return 1
+                      _ -> vsput True >> 
+                           crec1 >>= (\v ->
+                             (vsput s1 >> -- restore state type to si
+                              return (v + 10))))
+
+-- The same in the do-notation
+crec1_do :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int
+crec1_do = do
+	s1 <- vsget 
+        case fromEnum s1 of
+           0 -> return 0
+           1 -> do {vsput (pred s1); return 1}
+           _ -> do
+		vsput True
+                v <- crec1_do
+                vsput s1 -- restore state type to si
+                return (v + 10)
+
+
+test4 = IdM.runIdentity (runVST crec1 'a')
+-- ('a',11)
+
+test4_do = IdM.runIdentity (runVST crec1_do 'a')
+-- ('a',11)
+
+-- Another example, to illustrate locking and static reasoning about
+-- the locking state
+
+data Locked = Locked; data Unlocked = Unlocked
+newtype LIO p q a = LIO{unLIO::IO a}
+
+instance Monadish LIO where
+  return  = LIO . Prelude.return
+  m >>= f = LIO ((Prelude.>>=) (unLIO m) (unLIO . f))
+
+lput :: String -> LIO p p ()
+lput = LIO . putStrLn
+lget :: LIO p p String
+lget = LIO getLine
+
+-- In the real program, the following will execute actions to acquire
+-- or release the lock. Here, we just print out our intentions.
+lock :: LIO Unlocked Locked ()
+lock = LIO (putStrLn "Lock")
+
+unlock :: LIO Locked Unlocked ()
+unlock = LIO (putStrLn "UnLock")
+
+-- We should start in unlocked state, and finish in the same state
+runLIO :: LIO Unlocked Unlocked a -> IO a
+runLIO = unLIO
+
+-- User code
+
+tlock1 = lget >>=  (\l -> 
+	 return (read l) >>= (\x ->
+	 lput (show (x+1))))
+
+tlock1r = runLIO tlock1
+
+-- the same in the do-notation
+tlock1_do = do
+	    l <- lget
+	    let x = read l
+	    lput (show (x+1))
+
+{-
+  *VarStateM> :t tlock1
+  tlock1 :: LIO p p ()
+ Inferred type has the same input and output states and is polymorphic:
+ tlock1 does not affect the state of the lock.
+-}
+
+
+tlock2 = lget >>= (\l -> 
+	 lock >> (
+	 return (read l) >>= (\x ->
+	 lput (show (x+1)))))
+
+tlock2_do = do
+	    l <- lget
+	    lock
+	    let x = read l
+	    lput (show (x+1))
+
+{-
+  *VarStateM> :t tlock2
+  tlock2 :: LIO Unlocked Locked ()
+
+The inferred type says that the computation does the locking.
+-}
+
+tlock3 = tlock2 >> unlock
+tlock3r = runLIO tlock3
+
+{-
+  *DoParamM> :t tlock3
+  tlock3 :: LIO Unlocked Unlocked ()
+-}
+
+{-
+*DoParamM> tlock3r
+-- user input: 123
+Lock
+124
+UnLock
+-}
+
+tlock3_do = do {tlock2_do; unlock}
+tlock3r_do = runLIO tlock3_do
+
+
+-- An attempt to execute the following
+-- tlock4 = tlock2 >> tlock2
+
+{-
+ gives a type error:
+    Couldn't match expected type `Locked'
+	   against inferred type `Unlocked'
+      Expected type: LIO Locked r b
+      Inferred type: LIO Unlocked Locked ()
+    In the expression: tlock2
+    In a lambda abstraction: \ _ -> tlock2
+
+The error message correctly points out an error of acquiring an already
+held lock.
+-}
+
+-- The following too must be an error: with the SAME error message as above
+tlock4_do = do {tlock2_do; tlock2_do}
+
+-- Similarly, the following gives a type error because of an attempt
+-- to release a lock twice
+-- tlock4' = tlock2 >> unlock >> unlock
+{-
+DoParamM.hs:298:30:
+    Couldn't match expected type `Unlocked'
+	   against inferred type `Locked'
+      Expected type: LIO Unlocked r b
+      Inferred type: LIO Locked Unlocked ()
+    In the second argument of `(>>)', namely `unlock'
+    In the expression: (tlock2 >> unlock) >> unlock
+-}
+
+ -- The following too must be an error: with the SAME error message as above
+tlock4'_do = do {tlock2_do; unlock; unlock}
+
diff --git a/testsuite/tests/rebindable/DoParamM.stderr b/testsuite/tests/rebindable/DoParamM.stderr
new file mode 100644
index 0000000000..7abfdd4b56
--- /dev/null
+++ b/testsuite/tests/rebindable/DoParamM.stderr
@@ -0,0 +1,25 @@
+
+DoParamM.hs:146:25:
+    Couldn't match expected type `Int' with actual type `Char'
+    In the second argument of `(==)', namely `v''
+    In the first argument of `return', namely `(v == v')'
+    In a stmt of a 'do' block: return (v == v')
+
+DoParamM.hs:286:28:
+    Couldn't match expected type `Locked' with actual type `Unlocked'
+    Expected type: LIO Locked r0 b0
+      Actual type: LIO Unlocked Locked ()
+    In a stmt of a 'do' block: tlock2_do
+    In the expression:
+      do { tlock2_do;
+           tlock2_do }
+
+DoParamM.hs:302:37:
+    Couldn't match expected type `Unlocked' with actual type `Locked'
+    Expected type: LIO Unlocked r0 b0
+      Actual type: LIO Locked Unlocked ()
+    In a stmt of a 'do' block: unlock
+    In the expression:
+      do { tlock2_do;
+           unlock;
+           unlock }
diff --git a/testsuite/tests/rebindable/DoRestrictedM.hs b/testsuite/tests/rebindable/DoRestrictedM.hs
new file mode 100644
index 0000000000..dea2b1ea03
--- /dev/null
+++ b/testsuite/tests/rebindable/DoRestrictedM.hs
@@ -0,0 +1,99 @@
+{-# LANGUAGE RebindableSyntax, MultiParamTypeClasses,
+             FlexibleInstances #-}
+
+-- Tests of the do-notation for the restricted monads
+-- We demonstrate that all ordinary monads are restricted monads,
+-- and show the frequently requested implementation
+-- of MonadPlus in terms of Data.Set.
+-- 
+-- The tests are based on the code
+-- http://okmij.org/ftp/Haskell/types.html#restricted-datatypes
+
+module DoRestrictedM where
+
+import Data.List
+import Prelude (const, String, ($), (.), Maybe(..))
+import qualified Prelude
+import qualified Data.Set as Set
+
+-- Defining the restricted monad
+class MN2 m a where
+    return  :: a -> m a
+    fail    :: String -> m a
+
+class (MN2 m a, MN2 m b) => MN3 m a b where
+    (>>=) :: m a -> (a -> m b) -> m b
+
+m1 >> m2 = m1 >>= (const m2)
+
+-- All regular monads are the instances of the restricted monad
+
+newtype RegularM m a = RegularM{unRM :: m a}
+
+instance Prelude.Monad m => MN2 (RegularM m) a where
+    return = RegularM . Prelude.return
+    fail   = RegularM . Prelude.fail
+
+instance Prelude.Monad m => MN3 (RegularM m) a b where
+    m >>= f = RegularM ((Prelude.>>=) (unRM m) (unRM . f))
+
+-- We try to inject Maybe (as the regular monad) into Restricted Monad
+
+test1s () =  return "a" >>= (\x -> return $ "b" ++ x)
+test1f () =  fail ""    >>= (\x -> return $ "b" ++ x)
+
+-- the same with the do-notation
+
+test1s_do () = do
+  x <- return "a"
+  return $ "b" ++ x
+
+
+{-
+whose inferred type is
+   *DoRestrictedM> :t test1s
+   test1s :: (MN3 m [Prelude.Char] [Prelude.Char]) => () -> m [Prelude.Char]
+-}
+
+test1sr :: Maybe String
+test1sr = unRM $ test1s ()
+-- Just "ba"
+
+test1fr :: Maybe String
+test1fr = unRM $ test1f ()
+-- Nothing
+
+test1sr_do :: Maybe String
+test1sr_do = unRM $ test1s_do ()
+-- Just "ba"
+
+-- As often requested, we implement a MonadPlus `monad'
+-- in terms of a Set. Set requires the Ord constraint.
+
+newtype SMPlus a = SMPlus{unSM:: Set.Set a}
+
+instance MN2 SMPlus a where
+    return = SMPlus . Set.singleton
+    fail x = SMPlus $ Set.empty
+
+instance Prelude.Ord b => MN3 SMPlus a b where
+    m >>= f = SMPlus (Set.fold (Set.union . unSM . f) Set.empty (unSM m))
+
+-- We cannot forget the Ord constraint, because the typechecker
+-- will complain (and tell us exactly what we have forgotten).
+
+-- Now we can instantiate the previously written test1s and test1d 
+-- functions for this Set monad:
+
+test2sr :: Set.Set String
+test2sr = unSM $ test1s ()
+-- fromList ["ba"]
+
+test2fr :: Set.Set String
+test2fr = unSM $ test1f ()
+-- fromList []
+
+test2sr_do :: Set.Set String
+test2sr_do = unSM $ test1s_do ()
+-- fromList ["ba"]
+
diff --git a/testsuite/tests/rebindable/Makefile b/testsuite/tests/rebindable/Makefile
new file mode 100644
index 0000000000..9a36a1c5fe
--- /dev/null
+++ b/testsuite/tests/rebindable/Makefile
@@ -0,0 +1,3 @@
+TOP=../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/rebindable/T303.hs b/testsuite/tests/rebindable/T303.hs
new file mode 100644
index 0000000000..418a695e8d
--- /dev/null
+++ b/testsuite/tests/rebindable/T303.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE RebindableSyntax #-}

+

+-- Trac #303

+

+module T where

+import qualified Prelude as P

+

+class IxMonad m where

+    return :: a -> m i i a

+    (>>=) :: m i j a -> (a -> m j k b) -> m i k b

+    (>>)  :: m i j a -> m j k b -> m i k b

+    m >> n = m >>= \_ -> n

+

+    fail :: P.String -> m i j a

+    fail s = P.error s

+

+data T a b c = T

+instance IxMonad T where

+    return _ = T

+    m >>= f  = T

+    fail _   = T

+

+testM :: T (a,b) b a

+testM = T

+

+test1 = testM >>= \x -> return x

+

+test2  = do

+   x <- testM

+   return x

diff --git a/testsuite/tests/rebindable/T4851.hs b/testsuite/tests/rebindable/T4851.hs
new file mode 100644
index 0000000000..38ce45212f
--- /dev/null
+++ b/testsuite/tests/rebindable/T4851.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE Arrows, RebindableSyntax #-}
+module T4851 where
+
+import Prelude hiding ( id, (.) )
+
+import Control.Category	( Category(..) )
+import Control.Arrow
+
+garbage x =
+  proc b ->
+    do rec (c, d) <- undefined -< (b, d)
+       returnA -< c
diff --git a/testsuite/tests/rebindable/T5038.hs b/testsuite/tests/rebindable/T5038.hs
new file mode 100644
index 0000000000..42f3df2712
--- /dev/null
+++ b/testsuite/tests/rebindable/T5038.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE RebindableSyntax #-}
+module Main (main) where
+
+import Prelude 
+
+ifThenElse True t f = f
+ifThenElse False t f = t
+
+main = print (if True then 1 else 2 :: Int)
+-- Should print 2!
diff --git a/testsuite/tests/rebindable/T5038.stdout b/testsuite/tests/rebindable/T5038.stdout
new file mode 100644
index 0000000000..0cfbf08886
--- /dev/null
+++ b/testsuite/tests/rebindable/T5038.stdout
@@ -0,0 +1 @@
+2
diff --git a/testsuite/tests/rebindable/all.T b/testsuite/tests/rebindable/all.T
new file mode 100644
index 0000000000..7df16d4135
--- /dev/null
+++ b/testsuite/tests/rebindable/all.T
@@ -0,0 +1,31 @@
+# These tests try test the rebindable-syntax feature of GHC,
+# which you get when you use -XNoImplicitPrelude
+#
+# Written by Ashley Yakeley
+
+# No point in doing anything except the normal way 
+setTestOpts(only_ways(['normal']));
+setTestOpts(only_compiler_types(['ghc']))
+
+test('rebindable1', normal, compile, [''])
+test('rebindable2', normal, compile_and_run, [''])
+test('rebindable3', normal, compile_and_run, [''])
+test('rebindable4', normal, compile_and_run, [''])
+test('rebindable5', normal, compile_and_run, [''])
+
+# rebindable6 has become expected failures
+# following Trac #1537
+test('rebindable6', normal, compile_fail, [''])
+
+test('rebindable7', normal, compile_and_run, [''])
+test('rebindable8', normal, compile, [''])
+test('rebindable9', normal, compile, [''])
+test('rebindable10', normal, compile_and_run, [''])
+
+test('T303', normal, compile, [''])
+
+# Tests from Oleg
+test('DoRestrictedM', normal, compile, [''])
+test('DoParamM', reqlib('mtl'), compile_fail, [''])
+test('T5038', normal, compile_and_run, [''])
+test('T4851', normal, compile, [''])
diff --git a/testsuite/tests/rebindable/rebindable1.hs b/testsuite/tests/rebindable/rebindable1.hs
new file mode 100644
index 0000000000..1fb0b596fb
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable1.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}
+
+module RebindableCase1 where
+	{
+--	import Prelude;
+	import Prelude(String,undefined,Maybe(..), (==), (>=) );
+
+	return :: a;
+	return = undefined;
+
+	infixl 1 >>=;
+	(>>=) :: a;
+	(>>=) = undefined;
+	
+	infixl 1 >>;
+	(>>) :: a;
+	(>>) = undefined;
+
+	fail :: a;
+	fail = undefined;
+
+	fromInteger :: a;
+	fromInteger = undefined;
+
+	fromRational :: a;
+	fromRational = undefined;
+
+	negate :: a;
+	negate = undefined;
+
+	(-) :: a;
+	(-) = undefined;
+
+
+	test_do f g = do
+		{
+		f;
+		Just a <- g;
+		return a;
+		};
+	
+	test_fromInteger = 1;
+	
+	test_fromRational = 0.5;
+
+	test_negate a = - a;
+
+	test_fromInteger_pattern 1 = undefined;
+	test_fromInteger_pattern (-1) = undefined;
+	test_fromInteger_pattern (a + 7) = a;
+
+	test_fromRational_pattern 0.5 = undefined;
+	test_fromRational_pattern (-0.5) = undefined;
+	test_fromRational_pattern _ = undefined;
+	}
diff --git a/testsuite/tests/rebindable/rebindable1.stderr b/testsuite/tests/rebindable/rebindable1.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable1.stderr
diff --git a/testsuite/tests/rebindable/rebindable10.hs b/testsuite/tests/rebindable/rebindable10.hs
new file mode 100644
index 0000000000..5123f0e175
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable10.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE RebindableSyntax #-}
+module Main where
+import Prelude
+
+ifThenElse :: Int -> String -> String -> String
+ifThenElse a b c = case a > 0 of
+    True -> b
+    False -> c
+
+main :: IO ()
+main = do
+     print $ if -5 then "this fails" else "this works"
+     print $ if 5 then "this works" else "this fails"
\ No newline at end of file
diff --git a/testsuite/tests/rebindable/rebindable10.stdout b/testsuite/tests/rebindable/rebindable10.stdout
new file mode 100644
index 0000000000..925fc6dc09
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable10.stdout
@@ -0,0 +1,2 @@
+"this works"
+"this works"
diff --git a/testsuite/tests/rebindable/rebindable2.hs b/testsuite/tests/rebindable/rebindable2.hs
new file mode 100644
index 0000000000..7b626585ba
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable2.hs
@@ -0,0 +1,122 @@
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}
+
+module Main where
+	{
+--	import Prelude;
+	import qualified Prelude;
+	import Prelude(String,undefined,Maybe(..),IO,putStrLn,
+		Integer,(++),Rational, (==), (>=) );
+	
+	import Prelude(Monad(..));
+
+	debugFunc :: String -> IO a -> IO a;
+	debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
+		(ioa Prelude.>>= (\a -> 
+			(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
+		));
+
+	newtype TM a = MkTM {unTM :: IO a};
+
+	instance (Monad TM) where
+		{
+		return a = MkTM (debugFunc "return" (Prelude.return a));
+
+		(>>=) ma amb = MkTM (debugFunc ">>=" ((Prelude.>>=) (unTM ma) (\a -> unTM (amb a))));
+	
+		(>>) ma mb = MkTM (debugFunc ">>" ((Prelude.>>) (unTM ma) (unTM mb)));
+
+		fail s = MkTM (debugFunc "fail" (Prelude.return undefined));
+		};
+
+	preturn a = MkTM (Prelude.return a);
+
+	fromInteger :: Integer -> Integer;
+	fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
+
+	fromRational :: Rational -> Rational;
+	fromRational a = a Prelude.+ a Prelude.+ a; -- three times
+
+	negate :: a -> a;
+	negate a = a; -- don't actually negate
+
+	(-) :: a -> a -> a;
+	(-) x y = y; -- changed function
+
+
+	test_do f g = do
+		{
+		f;				-- >>
+		Just a <- g;	-- >>= (and fail if g returns Nothing)
+		return a;		-- return
+		};
+	
+	test_fromInteger = 27;
+	
+	test_fromRational = 31.5;
+
+	test_negate a = - a;
+
+	test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
+	test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
+	test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
+
+	test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
+	test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
+	test_fromRational_pattern a = "_=" ++ (Prelude.show a);
+
+	tmPutStrLn s = MkTM (putStrLn s);
+
+	doTest :: String -> TM a -> IO ();
+	doTest s ioa =
+		(putStrLn ("start test " ++ s))
+			Prelude.>>
+		(unTM ioa)
+			Prelude.>>
+		(putStrLn ("end test " ++ s));
+
+	main :: IO ();
+	main = 
+		(doTest "test_do failure"
+			(test_do (preturn ()) (preturn Nothing))
+		)
+			Prelude.>>
+		(doTest "test_do success"
+			(test_do (preturn ()) (preturn (Just ())))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger"
+			(tmPutStrLn (Prelude.show test_fromInteger)) -- 27 * 5 = 135
+		)
+			Prelude.>>
+		(doTest "test_fromRational"
+			(tmPutStrLn (Prelude.show test_fromRational)) -- 31.5 * 3 = 189%2
+		)
+			Prelude.>>
+		(doTest "test_negate"
+			(tmPutStrLn (Prelude.show (test_negate 3))) -- 3 * 5 = 15, non-negate
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 1"
+			(tmPutStrLn (test_fromInteger_pattern 1)) -- 1 * 5 = 5, matches "1"
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern (-2)"
+			(tmPutStrLn (test_fromInteger_pattern (-2))) -- "-2" = 2 * 5 = 10
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 9"
+			(tmPutStrLn (test_fromInteger_pattern 9)) -- "9" = 45, 45 "-" "7" = "7" = 35
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 0.5"
+			(tmPutStrLn (test_fromRational_pattern 0.5)) -- "0.5" = 3%2
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern (-0.7)"
+			(tmPutStrLn (test_fromRational_pattern (-0.7))) -- "-0.7" = "0.7" = 21%10
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 1.7"
+			(tmPutStrLn (test_fromRational_pattern 1.7)) -- "1.7" = 51%10
+		);
+	}
diff --git a/testsuite/tests/rebindable/rebindable2.stdout b/testsuite/tests/rebindable/rebindable2.stdout
new file mode 100644
index 0000000000..970af0f0ab
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable2.stdout
@@ -0,0 +1,43 @@
+start test test_do failure
+++ >>
+++ >>=
+++ fail
+-- fail
+-- >>=
+-- >>
+end test test_do failure
+start test test_do success
+++ >>
+++ >>=
+++ return
+-- return
+-- >>=
+-- >>
+end test test_do success
+start test test_fromInteger
+135
+end test test_fromInteger
+start test test_fromRational
+189 % 2
+end test test_fromRational
+start test test_negate
+15
+end test test_negate
+start test test_fromInteger_pattern 1
+1=5
+end test test_fromInteger_pattern 1
+start test test_fromInteger_pattern (-2)
+(-2)=10
+end test test_fromInteger_pattern (-2)
+start test test_fromInteger_pattern 9
+(a + 7)=35
+end test test_fromInteger_pattern 9
+start test test_fromRational_pattern 0.5
+0.5=3 % 2
+end test test_fromRational_pattern 0.5
+start test test_fromRational_pattern (-0.7)
+(-0.7)=21 % 10
+end test test_fromRational_pattern (-0.7)
+start test test_fromRational_pattern 1.7
+_=51 % 10
+end test test_fromRational_pattern 1.7
diff --git a/testsuite/tests/rebindable/rebindable3.hs b/testsuite/tests/rebindable/rebindable3.hs
new file mode 100644
index 0000000000..682787fced
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable3.hs
@@ -0,0 +1,119 @@
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}
+
+module Main where
+	{
+--	import Prelude;
+	import qualified Prelude;
+	import Prelude(String,undefined,Maybe(..),IO,putStrLn,
+		Integer,(++),Rational, (==), (>=) );
+
+	debugFunc :: String -> IO a -> IO a;
+	debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
+		(ioa Prelude.>>= (\a -> 
+			(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
+		));
+
+	return :: a -> IO a;
+	return a = debugFunc "return" (Prelude.return a);
+
+	infixl 1 >>=;
+	(>>=) :: IO a -> (a -> IO b) -> IO b;
+	(>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
+	
+	infixl 1 >>;
+	(>>) :: IO a -> IO b -> IO b;
+	(>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
+
+	fail :: String -> IO a;
+	fail s = debugFunc "fail" (Prelude.return undefined);
+--	fail s = debugFunc "fail" (Prelude.fail s);
+
+	fromInteger :: Integer -> Integer;
+	fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
+
+	fromRational :: Rational -> Rational;
+	fromRational a = a Prelude.+ a Prelude.+ a; -- three times
+
+	negate :: a -> a;
+	negate a = a; -- don't actually negate
+
+	(-) :: a -> a -> a;
+	(-) x y = y; -- changed function
+
+
+	test_do f g = do
+		{
+		f;				-- >>
+		Just a <- g;	-- >>= (and fail if g returns Nothing)
+		return a;		-- return
+		};
+	
+	test_fromInteger = 27;
+	
+	test_fromRational = 31.5;
+
+	test_negate a = - a;
+
+	test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
+	test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
+	test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
+
+	test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
+	test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
+	test_fromRational_pattern a = "_=" ++ (Prelude.show a);
+
+
+	doTest :: String -> IO a -> IO ();
+	doTest s ioa = 
+		(putStrLn ("start test " ++ s))
+			Prelude.>>
+		ioa
+			Prelude.>>
+		(putStrLn ("end test " ++ s));
+
+	main :: IO ();
+	main = 
+		(doTest "test_do failure"
+			(test_do (Prelude.return ()) (Prelude.return Nothing))
+		)
+			Prelude.>>
+		(doTest "test_do success"
+			(test_do (Prelude.return ()) (Prelude.return (Just ())))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger"
+			(putStrLn (Prelude.show test_fromInteger))
+		)
+			Prelude.>>
+		(doTest "test_fromRational"
+			(putStrLn (Prelude.show test_fromRational))
+		)
+			Prelude.>>
+		(doTest "test_negate"
+			(putStrLn (Prelude.show (test_negate 3)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 1"
+			(putStrLn (test_fromInteger_pattern 1))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern (-2)"
+			(putStrLn (test_fromInteger_pattern (-2)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 9"
+			(putStrLn (test_fromInteger_pattern 9))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 0.5"
+			(putStrLn (test_fromRational_pattern 0.5))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern (-0.7)"
+			(putStrLn (test_fromRational_pattern (-0.7)))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 1.7"
+			(putStrLn (test_fromRational_pattern 1.7))
+		);
+	}
diff --git a/testsuite/tests/rebindable/rebindable3.stdout b/testsuite/tests/rebindable/rebindable3.stdout
new file mode 100644
index 0000000000..970af0f0ab
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable3.stdout
@@ -0,0 +1,43 @@
+start test test_do failure
+++ >>
+++ >>=
+++ fail
+-- fail
+-- >>=
+-- >>
+end test test_do failure
+start test test_do success
+++ >>
+++ >>=
+++ return
+-- return
+-- >>=
+-- >>
+end test test_do success
+start test test_fromInteger
+135
+end test test_fromInteger
+start test test_fromRational
+189 % 2
+end test test_fromRational
+start test test_negate
+15
+end test test_negate
+start test test_fromInteger_pattern 1
+1=5
+end test test_fromInteger_pattern 1
+start test test_fromInteger_pattern (-2)
+(-2)=10
+end test test_fromInteger_pattern (-2)
+start test test_fromInteger_pattern 9
+(a + 7)=35
+end test test_fromInteger_pattern 9
+start test test_fromRational_pattern 0.5
+0.5=3 % 2
+end test test_fromRational_pattern 0.5
+start test test_fromRational_pattern (-0.7)
+(-0.7)=21 % 10
+end test test_fromRational_pattern (-0.7)
+start test test_fromRational_pattern 1.7
+_=51 % 10
+end test test_fromRational_pattern 1.7
diff --git a/testsuite/tests/rebindable/rebindable4.hs b/testsuite/tests/rebindable/rebindable4.hs
new file mode 100644
index 0000000000..2c25c9a03f
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable4.hs
@@ -0,0 +1,127 @@
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns #-}
+
+module Main where
+	{
+--	import Prelude;
+	import qualified Prelude;
+	import Prelude(String,undefined,Maybe(..),IO,putStrLn,
+		Integer,(++),Rational, (==), (>=) );
+
+	debugFunc :: String -> IO a -> IO a;
+	debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
+		(ioa Prelude.>>= (\a -> 
+			(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
+		));
+
+	infixl 1 >>=;
+	infixl 1 >>;
+
+	class MyMonad m where
+		{
+		return :: a -> m a;
+		(>>=) :: m a -> (a -> m b) -> m b;
+		(>>) :: m a -> m b -> m b;
+		fail :: String -> m a;
+		};
+
+	instance MyMonad IO where
+		{
+		return a = debugFunc "return" (Prelude.return a);
+	
+		(>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
+		
+		(>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
+	
+		fail s = debugFunc "fail" (Prelude.return undefined);
+	--	fail s = debugFunc "fail" (Prelude.fail s);
+		};
+
+	fromInteger :: Integer -> Integer;
+	fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
+
+	fromRational :: Rational -> Rational;
+	fromRational a = a Prelude.+ a Prelude.+ a; -- three times
+
+	negate :: a -> a;
+	negate a = a; -- don't actually negate
+
+	(-) :: a -> a -> a;
+	(-) x y = y; -- changed function
+
+
+	test_do f g = do
+		{
+		f;				-- >>
+		Just a <- g;	-- >>= (and fail if g returns Nothing)
+		return a;		-- return
+		};
+	
+	test_fromInteger = 27;
+	
+	test_fromRational = 31.5;
+
+	test_negate a = - a;
+
+	test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
+	test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
+	test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
+
+	test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
+	test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
+	test_fromRational_pattern a = "_=" ++ (Prelude.show a);
+
+
+	doTest :: String -> IO a -> IO ();
+	doTest s ioa = 
+		(putStrLn ("start test " ++ s))
+			Prelude.>>
+		ioa
+			Prelude.>>
+		(putStrLn ("end test " ++ s));
+
+	main :: IO ();
+	main = 
+		(doTest "test_do failure"
+			(test_do (Prelude.return ()) (Prelude.return Nothing))
+		)
+			Prelude.>>
+		(doTest "test_do success"
+			(test_do (Prelude.return ()) (Prelude.return (Just ())))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger"
+			(putStrLn (Prelude.show test_fromInteger))
+		)
+			Prelude.>>
+		(doTest "test_fromRational"
+			(putStrLn (Prelude.show test_fromRational))
+		)
+			Prelude.>>
+		(doTest "test_negate"
+			(putStrLn (Prelude.show (test_negate 3)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 1"
+			(putStrLn (test_fromInteger_pattern 1))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern (-2)"
+			(putStrLn (test_fromInteger_pattern (-2)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 9"
+			(putStrLn (test_fromInteger_pattern 9))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 0.5"
+			(putStrLn (test_fromRational_pattern 0.5))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern (-0.7)"
+			(putStrLn (test_fromRational_pattern (-0.7)))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 1.7"
+			(putStrLn (test_fromRational_pattern 1.7))
+		);
+	}
diff --git a/testsuite/tests/rebindable/rebindable4.stdout b/testsuite/tests/rebindable/rebindable4.stdout
new file mode 100644
index 0000000000..970af0f0ab
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable4.stdout
@@ -0,0 +1,43 @@
+start test test_do failure
+++ >>
+++ >>=
+++ fail
+-- fail
+-- >>=
+-- >>
+end test test_do failure
+start test test_do success
+++ >>
+++ >>=
+++ return
+-- return
+-- >>=
+-- >>
+end test test_do success
+start test test_fromInteger
+135
+end test test_fromInteger
+start test test_fromRational
+189 % 2
+end test test_fromRational
+start test test_negate
+15
+end test test_negate
+start test test_fromInteger_pattern 1
+1=5
+end test test_fromInteger_pattern 1
+start test test_fromInteger_pattern (-2)
+(-2)=10
+end test test_fromInteger_pattern (-2)
+start test test_fromInteger_pattern 9
+(a + 7)=35
+end test test_fromInteger_pattern 9
+start test test_fromRational_pattern 0.5
+0.5=3 % 2
+end test test_fromRational_pattern 0.5
+start test test_fromRational_pattern (-0.7)
+(-0.7)=21 % 10
+end test test_fromRational_pattern (-0.7)
+start test test_fromRational_pattern 1.7
+_=51 % 10
+end test test_fromRational_pattern 1.7
diff --git a/testsuite/tests/rebindable/rebindable5.hs b/testsuite/tests/rebindable/rebindable5.hs
new file mode 100644
index 0000000000..94b3f4ef7a
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable5.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns, FlexibleInstances,
+             MultiParamTypeClasses, FunctionalDependencies #-}
+
+module Main where
+	{
+--	import Prelude;
+	import qualified Prelude;
+	import Prelude(String,undefined,Maybe(..),IO,putStrLn,
+		Integer,(++),Rational, (==), (>=) );
+
+	debugFunc :: String -> IO a -> IO a;
+	debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
+		(ioa Prelude.>>= (\a -> 
+			(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
+		));
+
+	infixl 1 >>=;
+	infixl 1 >>;
+
+	returnIO :: a -> IO a;
+        returnIO = Prelude.return;
+	
+	class HasReturn m where
+		{
+		return :: a -> m a;
+		};
+
+	class HasBind m n mn | m n -> mn, m mn -> n where
+		{
+		(>>=) :: m a -> (a -> n b) -> mn b;
+		};
+
+	class HasSeq m n mn | m n -> mn, m mn -> n where
+		{
+		(>>) :: m a -> n b -> mn b;
+		};
+
+	class HasFail m where
+		{
+		fail :: String -> m a;
+		};
+
+	instance HasReturn IO where
+		{
+		return a = debugFunc "return" (returnIO a);
+		};
+
+	instance HasBind IO IO IO where
+		{
+		(>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
+		};
+
+	instance HasSeq IO IO IO where
+		{
+		(>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
+		};
+
+	instance HasFail IO where
+		{
+		fail s = debugFunc "fail" (returnIO undefined);
+	--	fail s = debugFunc "fail" (Prelude.fail s);
+		};
+
+	class HasFromInteger a where
+		{
+		fromInteger :: a -> a;
+		};
+
+	instance HasFromInteger Integer where
+		{
+		fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
+		};
+
+	class HasFromRational a where
+		{
+		fromRational :: a -> a;
+		};
+
+	instance HasFromRational Rational where
+		{
+		fromRational a = a Prelude.+ a Prelude.+ a; -- three times
+		};
+
+	class HasNegate a where
+		{
+		negate :: a -> a;
+		};
+
+	instance HasNegate Integer where
+		{
+		negate a = a; -- don't actually negate
+		};
+
+	instance HasNegate Rational where
+		{
+		negate a = a; -- don't actually negate
+		};
+
+	class HasMinus a where
+		{
+		(-) :: a -> a -> a;
+		};
+
+	instance HasMinus Rational where
+		{
+		(-) x y = y; -- changed function
+		};
+
+	instance HasMinus Integer where
+		{
+		(-) x y = y; -- changed function
+		};
+
+
+	test_do f g = do
+		{
+		f;				-- >>
+		Just a <- g;	-- >>= (and fail if g returns Nothing)
+		return a;		-- return
+		};
+	
+	test_fromInteger :: Integer;
+	test_fromInteger = 27;
+	
+	test_fromRational :: Rational;
+	test_fromRational = 31.5;
+
+	test_negate :: Integer -> Integer;
+	test_negate a = - a;
+
+	test_fromInteger_pattern :: Integer -> String;
+	test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
+	test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
+	test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
+
+	test_fromRational_pattern :: Rational -> String;
+	test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
+	test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
+	test_fromRational_pattern a = "_=" ++ (Prelude.show a);
+
+
+	doTest :: String -> IO a -> IO ();
+	doTest s ioa = 
+		(putStrLn ("start test " ++ s))
+			Prelude.>>
+		ioa
+			Prelude.>>
+		(putStrLn ("end test " ++ s));
+
+	main :: IO ();
+	main = 
+		(doTest "test_do failure"
+			(test_do (returnIO ()) (returnIO Nothing))
+		)
+			Prelude.>>
+		(doTest "test_do success"
+			(test_do (returnIO ()) (returnIO (Just ())))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger"
+			(putStrLn (Prelude.show test_fromInteger))
+		)
+			Prelude.>>
+		(doTest "test_fromRational"
+			(putStrLn (Prelude.show test_fromRational))
+		)
+			Prelude.>>
+		(doTest "test_negate"
+			(putStrLn (Prelude.show (test_negate 3)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 1"
+			(putStrLn (test_fromInteger_pattern 1))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern (-2)"
+			(putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 9"
+			(putStrLn (test_fromInteger_pattern 9))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 0.5"
+			(putStrLn (test_fromRational_pattern 0.5))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern (-0.7)"
+			(putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational)))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 1.7"
+			(putStrLn (test_fromRational_pattern 1.7))
+		)
+	   ;
+	}
diff --git a/testsuite/tests/rebindable/rebindable5.stderr b/testsuite/tests/rebindable/rebindable5.stderr
new file mode 100644
index 0000000000..e69de29bb2
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable5.stderr
diff --git a/testsuite/tests/rebindable/rebindable5.stdout b/testsuite/tests/rebindable/rebindable5.stdout
new file mode 100644
index 0000000000..970af0f0ab
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable5.stdout
@@ -0,0 +1,43 @@
+start test test_do failure
+++ >>
+++ >>=
+++ fail
+-- fail
+-- >>=
+-- >>
+end test test_do failure
+start test test_do success
+++ >>
+++ >>=
+++ return
+-- return
+-- >>=
+-- >>
+end test test_do success
+start test test_fromInteger
+135
+end test test_fromInteger
+start test test_fromRational
+189 % 2
+end test test_fromRational
+start test test_negate
+15
+end test test_negate
+start test test_fromInteger_pattern 1
+1=5
+end test test_fromInteger_pattern 1
+start test test_fromInteger_pattern (-2)
+(-2)=10
+end test test_fromInteger_pattern (-2)
+start test test_fromInteger_pattern 9
+(a + 7)=35
+end test test_fromInteger_pattern 9
+start test test_fromRational_pattern 0.5
+0.5=3 % 2
+end test test_fromRational_pattern 0.5
+start test test_fromRational_pattern (-0.7)
+(-0.7)=21 % 10
+end test test_fromRational_pattern (-0.7)
+start test test_fromRational_pattern 1.7
+_=51 % 10
+end test test_fromRational_pattern 1.7
diff --git a/testsuite/tests/rebindable/rebindable6.hs b/testsuite/tests/rebindable/rebindable6.hs
new file mode 100644
index 0000000000..74d861cda8
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable6.hs
@@ -0,0 +1,184 @@
+{-# LANGUAGE RebindableSyntax, NPlusKPatterns, Rank2Types,
+             ScopedTypeVariables, FlexibleInstances #-}
+module Main where
+	{
+--	import Prelude;
+	import qualified Prelude;
+	import Prelude(String,undefined,Maybe(..),IO,putStrLn,
+		Integer,(++),Rational, (==), (>=) );
+
+	debugFunc :: String -> IO a -> IO a;
+	debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>>
+		(ioa Prelude.>>= (\a -> 
+			(putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a)
+		));
+
+	infixl 1 >>=;
+	infixl 1 >>;
+
+	returnIO :: a -> IO a;
+        returnIO = Prelude.return;
+	
+	class HasReturn a where
+		{
+		return :: a;
+		};
+
+	class HasBind a where
+		{
+		(>>=) :: a;
+		};
+
+	class HasSeq a where
+		{
+		(>>) :: a;
+		};
+
+	class HasFail a where
+		{
+		fail :: a;
+		};
+
+	instance HasReturn (a -> IO a) where
+		{
+		return a = debugFunc "return" (Prelude.return a);
+		};
+
+	instance HasBind (IO a -> (a -> IO b) -> IO b) where
+		{
+		(>>=) ma amb = debugFunc ">>=" ((Prelude.>>=) ma amb);
+		};
+
+	instance HasSeq (IO a -> IO b -> IO b) where
+		{
+		(>>) ma mb = debugFunc ">>" ((Prelude.>>) ma mb);
+		};
+
+	instance HasFail (String -> IO a) where
+		{
+		fail s = debugFunc "fail" (Prelude.return undefined);
+	--	fail s = debugFunc "fail" (Prelude.fail s);
+		};
+
+	class HasFromInteger a where
+		{
+		fromInteger :: a;
+		};
+
+	instance HasFromInteger (Integer -> Integer) where
+		{
+		fromInteger a = a Prelude.+ a Prelude.+ a Prelude.+ a Prelude.+ a; -- five times
+		};
+
+	class HasFromRational a where
+		{
+		fromRational :: a;
+		};
+
+	instance HasFromRational (Rational -> Rational) where
+		{
+		fromRational a = a Prelude.+ a Prelude.+ a; -- three times
+		};
+
+	class HasNegate a where
+		{
+		negate :: a;
+		};
+
+	instance HasNegate (a -> a) where
+		{
+		negate a = a; -- don't actually negate
+		};
+
+	class HasMinus a where
+		{
+		(-) :: a;
+		};
+
+	instance HasMinus (a -> a -> a) where
+		{
+		(-) x y = y; -- changed function
+		};
+
+	test_do :: forall a b. IO a -> IO (Maybe b) -> IO b;
+	test_do f g = do
+		{
+		f;			-- >>
+		Just (b::b) <- g;	-- >>= (and fail if g returns Nothing)
+		return b;		-- return
+		};
+	
+	test_fromInteger :: Integer;
+	test_fromInteger = 27;
+	
+	test_fromRational :: Rational;
+	test_fromRational = 31.5;
+
+	test_negate :: Integer -> Integer;
+	test_negate a = - a;
+
+	test_fromInteger_pattern :: Integer -> String;
+	test_fromInteger_pattern a@1 = "1=" ++ (Prelude.show a);
+	test_fromInteger_pattern a@(-2) = "(-2)=" ++ (Prelude.show a);
+	test_fromInteger_pattern (a + 7) = "(a + 7)=" ++ Prelude.show a;
+
+	test_fromRational_pattern :: Rational -> String;
+	test_fromRational_pattern a@0.5 = "0.5=" ++ (Prelude.show a);
+	test_fromRational_pattern a@(-0.7) = "(-0.7)=" ++ (Prelude.show a);
+	test_fromRational_pattern a = "_=" ++ (Prelude.show a);
+
+
+	doTest :: String -> IO a -> IO ();
+	doTest s ioa = 
+		(putStrLn ("start test " ++ s))
+			Prelude.>>
+		ioa
+			Prelude.>>
+		(putStrLn ("end test " ++ s));
+
+	main :: IO ();
+	main = 
+		(doTest "test_do failure"
+			(test_do (Prelude.return ()) (Prelude.return Nothing))
+		)
+			Prelude.>>
+		(doTest "test_do success"
+			(test_do (Prelude.return ()) (Prelude.return (Just ())))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger"
+			(putStrLn (Prelude.show test_fromInteger))
+		)
+			Prelude.>>
+		(doTest "test_fromRational"
+			(putStrLn (Prelude.show test_fromRational))
+		)
+			Prelude.>>
+		(doTest "test_negate"
+			(putStrLn (Prelude.show (test_negate 3)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 1"
+			(putStrLn (test_fromInteger_pattern 1))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern (-2)"
+			(putStrLn (test_fromInteger_pattern (-(2::Integer)::Integer)))
+		)
+			Prelude.>>
+		(doTest "test_fromInteger_pattern 9"
+			(putStrLn (test_fromInteger_pattern 9))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 0.5"
+			(putStrLn (test_fromRational_pattern 0.5))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern (-0.7)"
+			(putStrLn (test_fromRational_pattern (-(0.7::Rational)::Rational)))
+		)
+			Prelude.>>
+		(doTest "test_fromRational_pattern 1.7"
+			(putStrLn (test_fromRational_pattern 1.7))
+		);
+	}
diff --git a/testsuite/tests/rebindable/rebindable6.stderr b/testsuite/tests/rebindable/rebindable6.stderr
new file mode 100644
index 0000000000..d451400514
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable6.stderr
@@ -0,0 +1,64 @@
+
+rebindable6.hs:106:17:
+    No instance for (HasSeq (IO a -> t0 -> IO b))
+      arising from a do statement
+    Possible fix:
+      add an instance declaration for (HasSeq (IO a -> t0 -> IO b))
+    In a stmt of a 'do' block: f
+    In the expression:
+      do { f;
+           Just (b :: b) <- g;
+           return b }
+    In an equation for `test_do':
+        test_do f g
+          = do { f;
+                 Just (b :: b) <- g;
+                 return b }
+
+rebindable6.hs:107:17:
+    No instance for (HasFail ([Prelude.Char] -> t1))
+      arising from a do statement
+    Possible fix:
+      add an instance declaration for (HasFail ([Prelude.Char] -> t1))
+    In a stmt of a 'do' block: Just (b :: b) <- g
+    In the expression:
+      do { f;
+           Just (b :: b) <- g;
+           return b }
+    In an equation for `test_do':
+        test_do f g
+          = do { f;
+                 Just (b :: b) <- g;
+                 return b }
+
+rebindable6.hs:107:17:
+    No instance for (HasBind (IO (Maybe b) -> (Maybe b -> t1) -> t0))
+      arising from a do statement
+    Possible fix:
+      add an instance declaration for
+      (HasBind (IO (Maybe b) -> (Maybe b -> t1) -> t0))
+    In a stmt of a 'do' block: Just (b :: b) <- g
+    In the expression:
+      do { f;
+           Just (b :: b) <- g;
+           return b }
+    In an equation for `test_do':
+        test_do f g
+          = do { f;
+                 Just (b :: b) <- g;
+                 return b }
+
+rebindable6.hs:108:17:
+    No instance for (HasReturn (b -> t1))
+      arising from a use of `return'
+    Possible fix: add an instance declaration for (HasReturn (b -> t1))
+    In a stmt of a 'do' block: return b
+    In the expression:
+      do { f;
+           Just (b :: b) <- g;
+           return b }
+    In an equation for `test_do':
+        test_do f g
+          = do { f;
+                 Just (b :: b) <- g;
+                 return b }
diff --git a/testsuite/tests/rebindable/rebindable6.stdout b/testsuite/tests/rebindable/rebindable6.stdout
new file mode 100644
index 0000000000..ff6a69e060
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable6.stdout
@@ -0,0 +1,43 @@
+start test test_do failure
+++ >>
+++ >>=
+++ fail
+-- fail
+-- >>=
+-- >>
+end test test_do failure
+start test test_do success
+++ >>
+++ >>=
+++ return
+-- return
+-- >>=
+-- >>
+end test test_do success
+start test test_fromInteger
+135
+end test test_fromInteger
+start test test_fromRational
+189%2
+end test test_fromRational
+start test test_negate
+15
+end test test_negate
+start test test_fromInteger_pattern 1
+1=5
+end test test_fromInteger_pattern 1
+start test test_fromInteger_pattern (-2)
+(-2)=10
+end test test_fromInteger_pattern (-2)
+start test test_fromInteger_pattern 9
+(a + 7)=35
+end test test_fromInteger_pattern 9
+start test test_fromRational_pattern 0.5
+0.5=3%2
+end test test_fromRational_pattern 0.5
+start test test_fromRational_pattern (-0.7)
+(-0.7)=21%10
+end test test_fromRational_pattern (-0.7)
+start test test_fromRational_pattern 1.7
+_=51%10
+end test test_fromRational_pattern 1.7
diff --git a/testsuite/tests/rebindable/rebindable7.hs b/testsuite/tests/rebindable/rebindable7.hs
new file mode 100644
index 0000000000..8e0000e0e5
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable7.hs
@@ -0,0 +1,38 @@
+{-# OPTIONS -XRebindableSyntax #-}

+

+-- This one tests rebindable syntax for do-notation

+

+module Main where

+

+import qualified Prelude

+import GHC.Num

+import GHC.Base hiding( Monad(..) )

+

+class Foo a where

+  op :: a -> a

+

+data T a = MkT a 

+

+instance Foo Int where

+  op x = x+1

+

+(>>=) :: Foo a => T a -> (a -> T b) -> T b

+(>>=) (MkT x) f = f (op x)

+

+(>>) :: Foo a => T a -> T b -> T b

+(>>) x y = x >>= (\_ -> y)

+

+return :: Num a => a -> T a

+return x = MkT (x+1)

+

+fail :: String -> T a

+fail s = error "urk"

+

+t1 :: T Int

+t1 = MkT 4

+

+myt = do { x <- t1

+	 ; return x }

+

+main = case myt of

+	 MkT i -> Prelude.print i

diff --git a/testsuite/tests/rebindable/rebindable7.stdout b/testsuite/tests/rebindable/rebindable7.stdout
new file mode 100644
index 0000000000..f1c101bdd7
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable7.stdout
@@ -0,0 +1 @@
+6

diff --git a/testsuite/tests/rebindable/rebindable8.hs b/testsuite/tests/rebindable/rebindable8.hs
new file mode 100644
index 0000000000..2c1f484f47
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable8.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE RebindableSyntax, MultiParamTypeClasses #-}
+
+-- Trac #1537
+
+module Foo where
+import Prelude hiding (Monad(..))
+
+class Bind m1 m2 m3 where 
+  (>>=) :: m1 a -> (a -> m2 b) -> m3 b
+
+class Return m where
+  return :: a -> m a
+  fail   :: String -> m a 
+
+instance Bind Maybe [] [] where
+  Just x  >>= f = f x
+  Nothing >>= f = []
+
+instance Return [] where 
+  return x = [x]
+  fail _   = [] 
+
+should_compile :: [Int]
+should_compile = do 
+  a <- Just 1
+  [a] 
diff --git a/testsuite/tests/rebindable/rebindable9.hs b/testsuite/tests/rebindable/rebindable9.hs
new file mode 100644
index 0000000000..081e22c46f
--- /dev/null
+++ b/testsuite/tests/rebindable/rebindable9.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE RebindableSyntax, FlexibleInstances,
+             MultiParamTypeClasses, FunctionalDependencies #-}
+
+-- Trac #1537
+
+module Foo where
+import qualified Prelude
+import Prelude hiding (Monad(..))
+
+newtype Identity a = Identity { runIdentity :: a }
+
+instance Prelude.Monad Identity where
+    return a = Identity a
+    m >>= k  = k (runIdentity m)
+
+class Bind m1 m2 m3 | m1 m2 -> m3 where 
+  (>>=) :: m1 a -> (a -> m2 b) -> m3 b
+
+class Return m where
+  returnM :: a -> m a
+  fail   :: String -> m a 
+
+instance Bind Maybe [] [] where
+  Just x  >>= f = f x
+  Nothing >>= f = []
+
+instance Functor a => Bind Identity a a 	where m >>= f = f (runIdentity m)
+instance Functor a => Bind a Identity a 	where m >>= f = fmap (runIdentity . f) m
+
+instance Prelude.Monad m => Bind m m m where (>>=) = (Prelude.>>=)
+
+instance Return [] where 
+  returnM x = [x]
+  fail _   = [] 
+
+return :: a -> Identity a
+return = Prelude.return
+
+should_compile :: [Int]
+should_compile = do 
+  a <- Just 1
+  b <- [a*1,a*2]
+  return (b+1)
\ No newline at end of file