blob: 4f6e4c476e2af956288338ec3704f53d92120f2f (
plain) (
blame)
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
|
implementation module Common
import StdFunc, StdList, StdString
instance Functor (Either e) where
(<$>) f (Left err) = Left err
(<$>) f (Right x) = Right (f x)
instance Applicative (Either e) where
pure x = Right x
(<*>) (Left err) _ = Left err
(<*>) (Right f) x = f <$> x
instance Monad (Either e) where
(>>=) (Left err) f = Left err
(>>=) (Right x) f = f x
instance toString Error
where
toString (Lextime e) = "Lexing error: " +++ e +++ "\n"
toString (Parsetime e) = "Parsing error: " +++ e +++ "\n"
toString (Runtime e) = "Runtime error: " +++ e +++ "\n"
toString (GenericError e) = "Error: " +++ e +++ "\n"
(<+) infixr 5 :: a b -> String | toString a & toString b
(<+) a b = toString a +++ toString b
($) infixr 0 :: (a -> b) a -> b
($) f x = f x
(*>) infixl 4 :: (f a) (f b) -> f b | Applicative f
(*>) fa fb = const id <$> fa <*> fb
(<*) infixl 4 :: (f a) (f b) -> f a | Applicative f
(<*) fa fb = const <$> fa <*> fb
some :: (f a) -> f [a] | Alternative f
some v = some_v
where
many_v = some_v <|> pure []
some_v = (\x xs -> [x:xs]) <$> v <*> many_v
many :: (f a) -> f [a] | Alternative f
many v = many_v
where
many_v = some_v <|> pure []
some_v = (\x xs -> [x:xs]) <$> v <*> many_v
sequence :: [a b] -> a [b] | Monad a
sequence ms = foldr k (pure []) ms
where k m m` = m >>= \x -> m` >>= \xs -> pure [x:xs]
mapM :: (a -> b c) [a] -> b [c] | Monad b
mapM f as = sequence (map f as)
foldM :: (a -> (b -> c a)) a [b] -> c a | Monad c
foldM _ a [] = pure a
foldM f a [x:xs] = f a x >>= \fax -> foldM f fax xs
liftM :: (a -> b) (c a) -> c b | Monad c
liftM f m1 = m1 >>= \x1 -> pure (f x1)
liftM2 :: (a -> (b -> c)) (d a) (d b) -> d c | Monad d
liftM2 f m1 m2 = m1 >>= \x1 -> m2 >>= \x2 -> pure (f x1 x2)
liftM3 :: (a -> (b -> (c -> d))) (e a) (e b) (e c) -> e d | Monad e
liftM3 f m1 m2 m3 = m1 >>= \x1 -> m2 >>= \x2 -> m3 >>= \x3 -> pure (f x1 x2 x3)
|
