testsuite: don't collect compiler stats in collect_runtime_residency
[ghc.git] / testsuite / tests / typecheck / should_run / tcrun010.hs
1 {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
2
3 -- !!! Functional dependencies
4 -- This one gave "zonkIdOcc: FunDep_a11w" in earlier days
5
6 module Main (main) where
7
8 data ERR a b = EOK a | ERR b deriving (Show)
9 data Error = No | Notatall deriving (Show, Eq)
10
11
12 class MonadErr m e | m -> e where
13 aerturn :: e -> m a
14 areturn :: a -> m a
15 acatch :: a -> (a -> m b) -> (e -> m b) -> m b
16 (>>>=) :: m a -> (a -> m b) -> m b
17 (>>>) :: m a -> m b -> m b
18
19 data BP a = BP (Int -> (ERR a Error, Int))
20
21 instance MonadErr BP Error where
22 aerturn k = BP $ \s -> (ERR k, s)
23 areturn k = BP $ \s -> (EOK k, s)
24 acatch k try handler = BP $ \s -> let BP try' = try k
25 (r,s1) = try' s
26 (BP c2, s2) = case r of
27 EOK r -> (areturn r, s1)
28 ERR r -> (handler r, s)
29 in c2 s2
30 a >>> b = a >>>= \_ -> b
31
32 (BP c1) >>>= fc2 = BP $ \s0 -> let (r,s1) = c1 s0
33 BP c2 = case r of
34 EOK r -> fc2 r
35 ERR r -> BP (\s -> (ERR r, s))
36 in c2 s1
37
38 run_BP :: Int -> BP a -> (ERR a Error, Int)
39 run_BP st (BP bp) = bp st
40
41 foo :: (ERR Int Error, Int)
42 foo = run_BP 111 (aerturn No)
43
44 main = print (show foo)