summaryrefslogtreecommitdiff
path: root/paper/While/Common.icl
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)