Mercurial > hg > Members > atton > delta_monad

comparison similar.hs @ 12:158ae705cd16

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Rename Similer -> Similar
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Tue, 02 Sep 2014 16:59:52 +0900
parents similer.hs@e8a5df54480e
children 88d6897c391a
comparison
equal deleted inserted replaced
11:e8a5df54480e 12:158ae705cd16
1 {-# LANGUAGE GADTs #-}
2
3 data Similar a = (Eq a) => Similar a (a -> a) a
4
5 instance (Eq a) => Eq (Similar a) where
6 s == ss = same s == same ss
7
8 same :: (Eq a) => Similar a -> a
9 same (Similar x f y) = if (f x) == y then y else undefined
10
11 mu :: (Eq a) => Similar (Similar a) -> Similar a
12 mu (Similar a f b) = if ((f a) == b) then b else undefined
13
14 class EqFunctor f where
15 eqmap :: (Eq a, Eq b) => (a -> b) -> f a -> f b
16
17 instance EqFunctor Similar where
18 eqmap f s = Similar fs id fs
19 where fs = f $ same s
20
21 class EqMonad m where
22 (>>=) :: (Eq a, Eq b) => m a -> (a -> m b) -> m b
23 return ::(Eq a) => a -> m a
24
25 instance EqMonad Similar where
26 return x = Similar x id x
27 s >>= f = mu (eqmap f s)
28
29 similar :: (Eq a) => (a -> a) -> (a -> a) -> a -> a
30 similar f g x = same $ Similar x g (f x)
31
32
33
34 double :: Int -> Int
35 double x = (2 * x)
36
37 twicePlus :: Int -> Int
38 twicePlus x = x + x
39
40 plusTwo :: Int -> Int
41 plusTwo x = x + 2
42
43 -- samples
44
45 {-
46 *Main> same $ Main.return 100 Main.>>= (\x -> Similar x twicePlus $ double x)
47 200
48
49 *Main> same $ Main.return 2 Main.>>= (\x -> Similar x plusTwo $ double x)
50 4
51
52 *Main> same $ Main.return 100 Main.>>= (\x -> Similar x plusTwo $ double x)
53 *** Exception: Prelude.undefined
54 -}
55