blob: 4e464d67f3555f65972cbd8dcb2e8d158e1c9735 (
plain)
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
|
{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
module T7729a where
import Control.Monad
class Monad m => PrimMonad m where
type PrimState m
class MonadTrans t where
lift :: Monad m => m a -> t m a
class (PrimMonad (BasePrimMonad m), Monad m) => MonadPrim m where
type BasePrimMonad m :: * -> *
liftPrim :: BasePrimMonad m a -> m a
newtype Rand m a = Rand {
runRand :: Maybe (m ()) -> m a
}
instance Monad m => Functor (Rand m) where
fmap = liftM
instance Monad m => Applicative (Rand m) where
pure = return
(<*>) = ap
instance (Monad m) => Monad (Rand m) where
return = Rand . const . return
(Rand rnd) >>= f = Rand $ \g -> (\x -> runRand (f x) g) =<< rnd g
instance MonadTrans Rand where
lift = Rand . const
instance MonadPrim m => MonadPrim (Rand m) where
type BasePrimMonad (Rand m) = BasePrimMonad m
liftPrim x = liftPrim (lift x) -- This line changed from T7729
{-
liftPrim :: (MonadPrim m) => BasePrimMonad m a -> m a
lift :: MonadTrans t, Monad m => m a -> t m a
sig of liftPrim :: BasePrimMonad (Rand m) a -> Rand m a
= BasePrimMonad m a -> Rand m a
x :: BasePrimMonad (Rand m) a
lift @ t=tt @ m=m1
liftPrim @ m=m2 @ a=aa
forall m. (Monad m) => BasePrimMonad (Rand m) a ~ m1 a -- x arg of lift
tt m1 a -- Result of lift
~
BasePrimMonad m2 a -- Arg of liftPrim
Rand m a -- expected type of RHS
~
m2 a -- Result of liftPrim
m = m_and
m1 = m_aql
m2 = m_aqf
tt = t_aqj
---->
m2 := Rand m
a) BasePrimMonad (Rand m) ~ m1
b) tt m1 ~ BasePrimMonad (Rand m)
---> process (b) first
CFunEqCan BasePrimMonad (Ramd m) ~ s_atH
s_atH ~ tt m1
---> now process (a)
m1 ~ s_atH ~ tt m1 -- An obscure occurs check
-}
|
