Mercurial > hg > Members > atton > delta_monad

comparison similar.hs @ 14:116131b196bb

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Define fmap and mu
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Sat, 06 Sep 2014 11:45:32 +0900
parents 88d6897c391a
children c599d2236d19
comparison
equal deleted inserted replaced
13:88d6897c391a 14:116131b196bb
1 data Similar a = Single a | Similar a (Similar a) 1 data Similar a = Single a | Similar a (Similar a) deriving (Show)
2
3 instance (Eq a) => Eq (Similar a) where
4 s == ss = (same s) == (same ss)
2 5
3 same :: (Eq a) => Similar a -> a 6 same :: (Eq a) => Similar a -> a
4 same (Single x) = x 7 same (Single x) = x
5 same (Similar x s) = if x == (same s) then x else undefined 8 same (Similar x s) = if x == (same s) then x else (error "same")
6 9
7 instance (Eq a) => Eq (Similar a) where
8 s == ss = (same s) == (same ss)
9 10
10 instance Functor Similar where 11 instance Functor Similar where
11 fmap f (Single a) = Single (f a) 12 fmap f (Single a) = Single (f a)
12 fmap f (Similar a s) = Similar (f a) (fmap f s) 13 fmap f (Similar a s) = Similar (f a) (fmap f s)
13 14
15 mu :: (Eq a) => (Similar (Similar a)) -> Similar a
16 mu (Single x) = x
17 mu (Similar (Single x) s) = Similar x (mu s)
18 mu (Similar s ss) = Similar (same s) (mu ss)
19
14 {- 20 {-
15 21 instance Monad Similar where
16 mu :: (Eq a) => Similar (Similar a) -> Similar a 22 return = Single
17 mu (Similar a f b) = if ((f a) == b) then b else undefined 23 (Single x) >>= f = f x
18 24 (Similar x s) >>= f = mu $ Similar (f x) (fmap f s)
19 similar :: (Eq a) => (a -> a) -> (a -> a) -> a -> a 25 -}
20 similar f g x = same $ Similar x g (f x)
21 26
22 27
23 28
24 double :: Int -> Int 29 double :: Int -> Similar Int
25 double x = (2 * x) 30 double x = Single (2 * x)
26 31
27 twicePlus :: Int -> Int 32 twicePlus :: Int -> Similar Int
28 twicePlus x = x + x 33 twicePlus x = Similar (x + x) (double x)
29 34
30 plusTwo :: Int -> Int 35 plusTwo :: Int -> Similar Int
31 plusTwo x = x + 2 36 plusTwo x = Similar (x + 2) (double x)
32 37
33 -- samples 38 -- samples
34 39
35 {- 40 {-
36 *Main> same $ Main.return 100 Main.>>= (\x -> Similar x twicePlus $ double x) 41 *Main> same $ Main.return 100 Main.>>= (\x -> Similar x twicePlus $ double x)
41 46
42 *Main> same $ Main.return 100 Main.>>= (\x -> Similar x plusTwo $ double x) 47 *Main> same $ Main.return 100 Main.>>= (\x -> Similar x plusTwo $ double x)
43 *** Exception: Prelude.undefined 48 *** Exception: Prelude.undefined
44 -} 49 -}
45 50
46 -}