1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
|
{-# OPTIONS -fglasgow-exts -fno-implicit-prelude #-}
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))
);
}
|