Ticket #1092: TT.hs

File TT.hs, 1.9 KB (added by ravi@…, 8 years ago)

the offending file

Line 
1module TT(foo) where
2
3newtype SEM e s a = M (s -> Either e (s, a))
4
5instance Monad (SEM e s) where
6    return a = M $ \ s -> Right (s, a)
7    M a >>= f = M $ \ s ->
8        case a s of
9        Left e -> Left e
10        Right (s', b) ->
11            let M f' = f b
12            in  f' s'
13
14run :: s -> SEM e s a -> Either e (s, a)
15run s (M m) = m s
16
17err :: e -> SEM e s a
18err msg = M (\s->Left msg)
19
20handle :: SEM e s a -> (e -> SEM e s a) -> SEM e s a
21handle (M a) f = M $ \ s ->
22    case a s of
23    Left e -> let (M b) = f e in b s
24    r -> r
25
26instance Functor (SEM e s) where
27  fmap f = (>>= return . f)
28
29type QQ = String
30
31rrrr i = "rrrr" ++ i
32
33{-# NOINLINE internalError #-}
34internalError = error
35
36data TTT
37        = VVVV String
38        | CCC String
39
40data ZZ =
41          FF ZZ QQ
42        | VV QQ
43        | AA ZZ [ZZ]
44        | FFTT QQ ZZ QQ
45        deriving (Eq, Ord, Show)
46
47ggg (FF _ i) = i
48ggg (VV i) = i
49ggg (AA f _) = ggg f
50ggg (FFTT i _ _) = i
51
52data Q = Q !Int 
53
54type MMMM a = SEM String Q a
55
56type CT e = [Z] -> TTT -> e -> MMMM ([V], e)
57
58data Z = Z [Int]
59data V = V [Int]
60
61data A = B | C (Maybe QQ)
62
63foo :: CT ZZ
64
65foo zzzz ddd (FF e i) = bar (C Nothing) zzzz ddd e i id
66foo zzzz ddd (FFTT tztt e i) = bar B zzzz ddd e i (const t)
67  where t = CCC (show tztt)
68
69foo zzzz ddd (AA (VV f) [xxx]) =
70    case (xxx) of
71        (FF e i) -> bar B zzzz ddd e i id
72
73baz :: MMMM (TTT, [V], ZZ) -> A -> CT ZZ
74baz bbb (C mmm) zzzz ddd ooo = do
75   (_, pppp, e) <- bbb
76
77   case (internalError "bar" , internalError "foo") of
78     (Just tztt, Nothing) -> do
79       let qzq_rrrr = rrrr (ggg e)
80       foo zzzz ddd (FFTT tztt ooo qzq_rrrr)
81
82bar :: A -> [Z] -> TTT -> ZZ -> QQ -> (TTT -> TTT) -> MMMM ([V], ZZ)
83bar abc zzzz ddd e i f = do
84
85    zztz        <- internalError (show i)
86
87    fffZZZ
88    case (f zztz) of
89      VVVV _ -> do
90           let bbb = internalError "foo"
91           baz bbb abc zzzz ddd (FF e i)     
92
93fffZZZ :: MMMM ()
94fffZZZ = internalError "fffZZZ"
95
96
97