-
Notifications
You must be signed in to change notification settings - Fork 0
/
pr1_norm.hs
71 lines (53 loc) · 1.67 KB
/
pr1_norm.hs
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
import Control.Applicative
import Control.Monad (liftM, ap)
import Control.Category
data ACounter a = C (Int -> (Int, a))
data NewCounter a b = ArrowC (a -> b)
data SecondCounter a b = ArrowD a b
-- increment the counter:
inc = get >>= \s -> (C $ \n -> (s+1, s+1))
--incArrow = getArrow Main.>>> arr (\n -> n+1)
-- returning the current value of the counter
get :: ACounter Int
get = C $ \n -> (n, n)
--getArrow :: NewCounter Int Int
--getArrow = ArrowC $ \n -> n
instance Functor ACounter where
fmap = liftM
instance Applicative ACounter where
pure = return
(<*>) = ap
-- return is nop, >>= is sequential exectuion
instance Monad ACounter where
return r = C $ \n -> (n, r)
(>>=) (C f) g = C $ \n0 -> let (n1, r1) = f n0
C g' = g r1
in g' n1
class Arrow a where
arr :: (Num b) => (b -> b) -> a b b
(>>>) :: (Num b) => a b b -> a b b -> a b b
instance Arrow SecondCounter where
arr f = ArrowD 0 ((f 0) +1)
(>>>) (ArrowD a b) (ArrowD c d) = ArrowD a (b+d)
--instance Arrow NewCounter where
-- arr f = ArrowC f
-- (>>>) (ArrowC f) (ArrowC g) = ArrowC (f Prelude.. g)
--class Category c => CounterCat c where
-- id :: (Num a) => c a a
-- (.) :: c d e -> c a b -> c a e
--
--instance CounterCat NewCounter where
-- id = Main.arr Prelude.id
-- (ArrowC b c) . (ArrowC a d) = (ArrowC a c)
run :: ACounter a -> (Int, a)
run (C f) = (f 0)
--runArrow (ArrowC f) = f 0
runSecond (ArrowD a b) = (a,b)
--runSecond $ (Main.arr (\n -> 1)) Main.>>> (Main.arr (\n -> 2))
--temp :: Num a => NewCounter a a
--temp = arr (\n -> n+1)
tickC = do
inc
inc
c <- get
return c