diff options
author | Thomas Miedema <thomasmiedema@gmail.com> | 2016-06-18 22:44:19 +0200 |
---|---|---|
committer | Thomas Miedema <thomasmiedema@gmail.com> | 2016-06-20 16:22:07 +0200 |
commit | 915e07c33b143126e3c8de1d2ec22ccc709a9a24 (patch) | |
tree | fcde0a7ffc1466b6e53dbee6df835af07e9a7ecc /testsuite/tests/rebindable | |
parent | 46ff80f26d1892e1b50e3f10c5d3fded33da6e81 (diff) | |
download | haskell-915e07c33b143126e3c8de1d2ec22ccc709a9a24.tar.gz |
Testsuite: tabs -> spaces [skip ci]
Diffstat (limited to 'testsuite/tests/rebindable')
-rw-r--r-- | testsuite/tests/rebindable/DoParamM.hs | 76 | ||||
-rw-r--r-- | testsuite/tests/rebindable/T4851.hs | 2 | ||||
-rw-r--r-- | testsuite/tests/rebindable/rebindable1.hs | 74 | ||||
-rw-r--r-- | testsuite/tests/rebindable/rebindable2.hs | 232 | ||||
-rw-r--r-- | testsuite/tests/rebindable/rebindable3.hs | 232 | ||||
-rw-r--r-- | testsuite/tests/rebindable/rebindable4.hs | 248 | ||||
-rw-r--r-- | testsuite/tests/rebindable/rebindable5.hs | 382 | ||||
-rw-r--r-- | testsuite/tests/rebindable/rebindable6.hs | 350 |
8 files changed, 798 insertions, 798 deletions
diff --git a/testsuite/tests/rebindable/DoParamM.hs b/testsuite/tests/rebindable/DoParamM.hs index 95ff235cdd..686034fbcb 100644 --- a/testsuite/tests/rebindable/DoParamM.hs +++ b/testsuite/tests/rebindable/DoParamM.hs @@ -13,10 +13,10 @@ module DoParamM where -import Prelude (const, String, ($), (.), Maybe(..), - Int, fromInteger, succ, pred, fromEnum, toEnum, - (+), Char, (==), Bool(..), - IO, getLine, putStrLn, read, show) +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 @@ -38,7 +38,7 @@ instance Prelude.Monad m => Monadish (RegularM m) where 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 +-- 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 @@ -53,9 +53,9 @@ test1 = State.runState (unRM c) (0::Int) where -- The same in the do-notation test1_do = State.runState (unRM c) (0::Int) where c = do - v <- gget - gput (succ v) - return v + 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 () @@ -70,8 +70,8 @@ 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)) + 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)) @@ -84,9 +84,9 @@ vsm1 () = vsget >>= (\v -> vsput (succ v) >> return v) -- The same with the do-notation vsm1_do () = do - v <- vsget - vsput (succ v) - return v + v <- vsget + vsput (succ v) + return v {- *DoParamM> :t vsm1 @@ -102,7 +102,7 @@ test2_do = IdM.runIdentity (runVST (vsm1_do ()) (0::Int)) -- Now, we vary the type of the state, from Int to a Char -vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> +vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> vsget >>= \v' -> return (v,v')) {- @@ -113,10 +113,10 @@ vsm2 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> -- The same with the do-notation -- the following does not yet work vsm2_do () = do - v <- vsget + v <- vsget vsput ((toEnum (65+v))::Char) v' <- vsget - return (v,v') + return (v,v') test3 = IdM.runIdentity (runVST (vsm2 ()) (0::Int)) -- ('A',(0,'A')) @@ -132,7 +132,7 @@ test3_do = IdM.runIdentity (runVST (vsm2_do ()) (0::Int)) In the first argument of `return', namely `(v == v')' In the expression: return (v == v') -vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> +vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> vsget >>= \v' -> return (v==v')) -} @@ -140,10 +140,10 @@ vsm3 () = vsget >>= (\v -> vsput ((toEnum (65+v))::Char) >> -- 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 + v <- vsget vsput ((toEnum (65+v))::Char) v' <- vsget - return (v==v') + return (v==v') @@ -154,7 +154,7 @@ 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 >> + _ -> vsput True >> crec1 >>= (\v -> (vsput s1 >> -- restore state type to si return (v + 10)))) @@ -162,12 +162,12 @@ crec1 = vsget >>= (\s1 -> case fromEnum s1 of -- The same in the do-notation crec1_do :: (Prelude.Enum si, Prelude.Monad m) => VST m si si Int crec1_do = do - s1 <- vsget + s1 <- vsget case fromEnum s1 of 0 -> return 0 1 -> do {vsput (pred s1); return 1} _ -> do - vsput True + vsput True v <- crec1_do vsput s1 -- restore state type to si return (v + 10) @@ -208,17 +208,17 @@ runLIO = unLIO -- User code -tlock1 = lget >>= (\l -> - return (read l) >>= (\x -> - lput (show (x+1)))) +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)) + l <- lget + let x = read l + lput (show (x+1)) {- *VarStateM> :t tlock1 @@ -228,16 +228,16 @@ tlock1_do = do -} -tlock2 = lget >>= (\l -> - lock >> ( - return (read l) >>= (\x -> - lput (show (x+1))))) +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)) + l <- lget + lock + let x = read l + lput (show (x+1)) {- *VarStateM> :t tlock2 @@ -272,7 +272,7 @@ tlock3r_do = runLIO tlock3_do {- gives a type error: Couldn't match expected type `Locked' - against inferred type `Unlocked' + against inferred type `Unlocked' Expected type: LIO Locked r b Inferred type: LIO Unlocked Locked () In the expression: tlock2 @@ -291,7 +291,7 @@ tlock4_do = do {tlock2_do; tlock2_do} {- DoParamM.hs:298:30: Couldn't match expected type `Unlocked' - against inferred type `Locked' + against inferred type `Locked' Expected type: LIO Unlocked r b Inferred type: LIO Locked Unlocked () In the second argument of `(>>)', namely `unlock' diff --git a/testsuite/tests/rebindable/T4851.hs b/testsuite/tests/rebindable/T4851.hs index 38ce45212f..b06604615e 100644 --- a/testsuite/tests/rebindable/T4851.hs +++ b/testsuite/tests/rebindable/T4851.hs @@ -3,7 +3,7 @@ module T4851 where import Prelude hiding ( id, (.) ) -import Control.Category ( Category(..) ) +import Control.Category ( Category(..) ) import Control.Arrow garbage x = diff --git a/testsuite/tests/rebindable/rebindable1.hs b/testsuite/tests/rebindable/rebindable1.hs index 4ff8ed2d4d..8fcc5d2697 100644 --- a/testsuite/tests/rebindable/rebindable1.hs +++ b/testsuite/tests/rebindable/rebindable1.hs @@ -2,55 +2,55 @@ {-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} module RebindableCase1 where - { --- import Prelude; - import Prelude(String,undefined,Maybe(..), (==), (>=) ); + { +-- import Prelude; + import Prelude(String,undefined,Maybe(..), (==), (>=) ); - return :: a; - return = undefined; + return :: a; + return = undefined; - infixl 1 >>=; - (>>=) :: a; - (>>=) = undefined; + infixl 1 >>=; + (>>=) :: a; + (>>=) = undefined; - infixl 1 >>; - (>>) :: a; - (>>) = undefined; + infixl 1 >>; + (>>) :: a; + (>>) = undefined; - fail :: a; - fail = undefined; + fail :: a; + fail = undefined; - fromInteger :: a; - fromInteger = undefined; + fromInteger :: a; + fromInteger = undefined; - fromRational :: a; - fromRational = undefined; + fromRational :: a; + fromRational = undefined; - negate :: a; - negate = undefined; + negate :: a; + negate = undefined; - (-) :: a; - (-) = undefined; + (-) :: a; + (-) = undefined; - test_do f g = do - { - f; - Just a <- g; - return a; - }; + test_do f g = do + { + f; + Just a <- g; + return a; + }; - test_fromInteger = 1; + test_fromInteger = 1; - test_fromRational = 0.5; + test_fromRational = 0.5; - test_negate a = - a; + test_negate a = - a; - test_fromInteger_pattern 1 = undefined; - test_fromInteger_pattern (-1) = undefined; - test_fromInteger_pattern (a + 7) = 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; - } + test_fromRational_pattern 0.5 = undefined; + test_fromRational_pattern (-0.5) = undefined; + test_fromRational_pattern _ = undefined; + } diff --git a/testsuite/tests/rebindable/rebindable2.hs b/testsuite/tests/rebindable/rebindable2.hs index 2f69ac8f3f..e1f328954c 100644 --- a/testsuite/tests/rebindable/rebindable2.hs +++ b/testsuite/tests/rebindable/rebindable2.hs @@ -1,22 +1,22 @@ {-# LANGUAGE RebindableSyntax, NPlusKPatterns #-} module Main where - { --- import Prelude; - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); - - import Prelude(Monad(..),Applicative(..),Functor(..)); + { +-- import Prelude; + import qualified Prelude; + import Prelude(String,undefined,Maybe(..),IO,putStrLn, + Integer,(++),Rational, (==), (>=) ); + + import Prelude(Monad(..),Applicative(..),Functor(..)); import Control.Monad(ap, liftM); - debugFunc :: String -> IO a -> IO a; - debugFunc s ioa = (putStrLn ("++ " ++ s)) Prelude.>> - (ioa Prelude.>>= (\a -> - (putStrLn ("-- " ++ s)) Prelude.>> (Prelude.return a) - )); + 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}; + newtype TM a = MkTM {unTM :: IO a}; instance (Functor TM) where { @@ -27,106 +27,106 @@ module Main where pure = return; (<*>) = ap; }; - 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 - ); - } + 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/rebindable3.hs b/testsuite/tests/rebindable/rebindable3.hs index 682787fced..0434c1d0fd 100644 --- a/testsuite/tests/rebindable/rebindable3.hs +++ b/testsuite/tests/rebindable/rebindable3.hs @@ -1,119 +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)) - ); - } + { +-- 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/rebindable4.hs b/testsuite/tests/rebindable/rebindable4.hs index 2c25c9a03f..f657683a08 100644 --- a/testsuite/tests/rebindable/rebindable4.hs +++ b/testsuite/tests/rebindable/rebindable4.hs @@ -1,127 +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)) - ); - } + { +-- 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/rebindable5.hs b/testsuite/tests/rebindable/rebindable5.hs index 94b3f4ef7a..3120ea1a90 100644 --- a/testsuite/tests/rebindable/rebindable5.hs +++ b/testsuite/tests/rebindable/rebindable5.hs @@ -2,195 +2,195 @@ 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; + { +-- 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)) - ) - ; - } + + 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/rebindable6.hs b/testsuite/tests/rebindable/rebindable6.hs index 3ec03477d2..6ed8249400 100644 --- a/testsuite/tests/rebindable/rebindable6.hs +++ b/testsuite/tests/rebindable/rebindable6.hs @@ -6,183 +6,183 @@ {-# LANGUAGE TypeFamilies #-} module Main where - { - import qualified Prelude; - import Prelude(String,undefined,Maybe(..),IO,putStrLn, - Integer,(++),Rational, (==), (>=) ); + { + 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) - )); + 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 >>; + infixl 1 >>=; + infixl 1 >>; - returnIO :: a -> IO a; + 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 (b ~ (a -> a)) => HasNegate b where - { - negate a = a; -- don't actually negate - }; - - class HasMinus a where - { - (-) :: a; - }; - - instance (b ~ (a -> a -> a)) => HasMinus b 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)) - ); - } + 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 (b ~ (a -> a)) => HasNegate b where + { + negate a = a; -- don't actually negate + }; + + class HasMinus a where + { + (-) :: a; + }; + + instance (b ~ (a -> a -> a)) => HasMinus b 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)) + ); + } |