Make Applicative a superclass of Monad
[ghc.git] / testsuite / tests / typecheck / should_compile / tc213.hs
1 {-# LANGUAGE RankNTypes, ScopedTypeVariables, FlexibleInstances,
2 MultiParamTypeClasses, FunctionalDependencies #-}
3
4 -- This tests scoped type variables, used in an expression
5 -- type signature in t1 and t2
6
7 module Foo7 where
8 import Control.Monad hiding (empty)
9 import Control.Monad.ST
10 import Data.Array.MArray
11 import Data.Array.ST
12 import Data.STRef
13 import Data.Set hiding (map,filter)
14
15 -- a store that allows to mark keys
16 class Mark m store key | store -> key m where
17 new :: (key,key) -> m store
18 mark :: store -> key -> m ()
19 markQ :: store -> key -> m Bool
20 seen :: store -> m [ key ]
21
22 -- implementation 1
23 instance Ord key => Mark (ST s) (STRef s (Set key)) key where
24 new _ = newSTRef empty
25 mark s k = modifySTRef s (insert k)
26 markQ s k = liftM (member k) (readSTRef s)
27 seen s = liftM elems (readSTRef s)
28
29 -- implementation 2
30 instance Ix key => Mark (ST s) (STUArray s key Bool) key where
31 new bnd = newArray bnd False
32 mark s k = writeArray s k True
33 markQ = readArray
34 seen s = liftM (map fst . filter snd) (getAssocs s)
35
36 -- traversing the hull suc^*(start) with loop detection
37 trav suc start i = new i >>= \ c -> mapM_ (compo c) start >> return c
38 where compo c x = markQ c x >>= flip unless (visit c x)
39 visit c x = mark c x >> mapM_ (compo c) (suc x)
40
41 -- sample graph
42 f 1 = 1 : []
43 f n = n : f (if even n then div n 2 else 3*n+1)
44
45 t1 = runST ( (trav f [1..10] (1,52) >>= \ (s::STRef s (Set Int)) -> seen s)
46 :: forall s. ST s [Int] )
47
48 t2 = runST ( (trav f [1..10] (1,52) >>= \ (s::STUArray s Int Bool) -> seen s)
49 :: forall s. ST s [Int] )