Mercurial > hg > Members > atton > delta_monad

comparison similer.hs @ 11:e8a5df54480e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Define sample for Monad style
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Tue, 02 Sep 2014 16:25:53 +0900
parents 7c7efee7891f
children
comparison
equal deleted inserted replaced
10:7c7efee7891f 11:e8a5df54480e
1 {-# LANGUAGE GADTs, MultiParamTypeClasses #-} 1 {-# LANGUAGE GADTs #-}
2 2
3 data Similer a = (Eq a) => Similer a (a -> a) a 3 data Similer a = (Eq a) => Similer a (a -> a) a
4 4
5 instance (Eq a) => Eq (Similer a) where 5 instance (Eq a) => Eq (Similer a) where
6 s == ss = same s == same ss 6 s == ss = same s == same ss
7 7
8 same :: Similer a -> a 8 same :: (Eq a) => Similer a -> a
9 same (Similer x f y) = if (f x) == y then y else undefined 9 same (Similer x f y) = if (f x) == y then y else undefined
10 10
11 mu :: (Eq a) => Similer (Similer a) -> Similer a 11 mu :: (Eq a) => Similer (Similer a) -> Similer a
12 mu (Similer a f b) = if ((f a) == b) then b else undefined 12 mu (Similer a f b) = if ((f a) == b) then b else undefined
13 13
24 24
25 instance EqMonad Similer where 25 instance EqMonad Similer where
26 return x = Similer x id x 26 return x = Similer x id x
27 s >>= f = mu (eqmap f s) 27 s >>= f = mu (eqmap f s)
28 28
29 {- 29 similer :: (Eq a) => (a -> a) -> (a -> a) -> a -> a
30 eta :: a -> Similer a a 30 similer f g x = same $ Similer x g (f x)
31 eta a = Similer a id a 31
32 32
33 33
34 double :: Int -> Int 34 double :: Int -> Int
35 double x = (2 * x) 35 double x = (2 * x)
36 36
38 twicePlus x = x + x 38 twicePlus x = x + x
39 39
40 plusTwo :: Int -> Int 40 plusTwo :: Int -> Int
41 plusTwo x = x + 2 41 plusTwo x = x + 2
42 42
43 -- samples
43 44
44 similer :: (Show b, Eq b) => (a -> b) -> (a -> b) -> a -> b 45 {-
45 similer f g x = same $ Similer x g (f x) 46 *Main> same $ Main.return 100 Main.>>= (\x -> Similer x twicePlus $ double x)
47 200
46 48
49 *Main> same $ Main.return 2 Main.>>= (\x -> Similer x plusTwo $ double x)
50 4
47 51
48 -- samples 52 *Main> same $ Main.return 100 Main.>>= (\x -> Similer x plusTwo $ double x)
49 sameExample = map (similer twicePlus double) [1..10] 53 *** Exception: Prelude.undefined
50 nonSameExample = map (similer twicePlus plusTwo) [1..10]
51 nonSameExampleSpecific = map (similer twicePlus plusTwo) [2]
52 -} 54 -}