8c801a44f3e9bbd3fbb9afc54f2638e8e1f9eca2
3 -- See Trac #1627. The point is that we should get nice
4 -- compact code for Foo
6 -- In GHC 7.0 this fails, and rightly so.
8 module M(foo) where
11 import Data.Array.ST
13 data E' v m a where
14 E :: m a -> E' RValue m a
15 V :: m a -> (a -> m ()) -> E' v m a
17 data LValue
18 data RValue
20 type E m a = E' RValue m a
21 type V m a = E' LValue m a
23 {-# INLINE runE #-}
24 runE :: E' v m a -> m a
25 runE (E t) = t
26 runE (V t _) = t
29 {-# INLINE return #-}
30 return x = E \$ return x
31 {-# INLINE (>>=) #-}
32 x >>= f = E \$ do
33 x' <- runE x
34 runE (f x')
36 liftArray :: forall arr m a i . (Ix i, MArray arr a m) =>
37 arr i a -> E m (forall v . [E m i] -> E' v m a)
38 {-# INLINE liftArray #-}
39 liftArray a = E (do
40 let ix :: [E m i] -> m i
41 ix [i] = runE i
42 {-# INLINE f #-}
43 f is = V (ix is >>= readArray a) (\ x -> ix is >>= \ i -> writeArray a i x)
44 return f
45 )
47 {-# INLINE liftE2 #-}
48 liftE2 :: (Monad m) => (a -> b -> c) -> E' va m a -> E' vb m b -> E m c
49 liftE2 op x y = E \$ do
50 x' <- runE x
51 y' <- runE y
52 return (x' `op` y')
54 {-# INLINE plus #-}
55 plus :: (Monad m) => E m Int -> E m Int -> E m Int
56 plus = liftE2 (+)
58 foo :: forall s . STArray s Int Int -> ST s Int
59 foo ma = runE \$ do
60 a <- liftArray ma
61 let one :: E (ST t) Int
62 one = return 1
63 a[one] `plus` a[one]