Mercurial > hg > Members > atton > delta_monad

comparison similer.hs @ 10:7c7efee7891f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Define Monad style Similer
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Tue, 02 Sep 2014 16:12:34 +0900
parents 41c71f67c103
children e8a5df54480e
comparison
equal deleted inserted replaced
9:41c71f67c103 10:7c7efee7891f
1 data Similer a b = Similer a (a -> b) b 1 {-# LANGUAGE GADTs, MultiParamTypeClasses #-}
2 2
3 instance Functor (Similer a) where 3 data Similer a = (Eq a) => Similer a (a -> a) a
4 fmap g (Similer a f b) = Similer a (g . f) $ g b
5 4
6 eq :: (Eq a) => Similer a b -> Similer a b -> Bool 5 instance (Eq a) => Eq (Similer a) where
7 eq (Similer a _ _ ) (Similer b _ _) = a == b 6 s == ss = same s == same ss
8 7
8 same :: Similer a -> a
9 same (Similer x f y) = if (f x) == y then y else undefined
10
11 mu :: (Eq a) => Similer (Similer a) -> Similer a
12 mu (Similer 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 Similer where
18 eqmap f s = Similer 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 Similer where
26 return x = Similer x id x
27 s >>= f = mu (eqmap f s)
28
29 {-
9 eta :: a -> Similer a a 30 eta :: a -> Similer a a
10 eta a = Similer a id a 31 eta a = Similer a id a
11 32
12 mu :: (Eq b) => Similer a (Similer b c) -> Similer b c
13 mu (Similer a f b) = if (eq (f a) b) then b else undefined
14 33
15 double :: Int -> Int 34 double :: Int -> Int
16 double x = (2 * x) 35 double x = (2 * x)
17 36
18 twicePlus :: Int -> Int 37 twicePlus :: Int -> Int
19 twicePlus x = x + x 38 twicePlus x = x + x
20 39
21 plusTwo :: Int -> Int 40 plusTwo :: Int -> Int
22 plusTwo x = x + 2 41 plusTwo x = x + 2
23 42
24 same :: (Show b, Eq b) => Similer a b -> b
25 same (Similer x f y) = if (f x) == y then y else (error ("not same :" ++ show y))
26 43
27 similer :: (Show b, Eq b) => (a -> b) -> (a -> b) -> a -> b 44 similer :: (Show b, Eq b) => (a -> b) -> (a -> b) -> a -> b
28 similer f g x = same $ Similer x g (f x) 45 similer f g x = same $ Similer x g (f x)
29 46
30 47
31 -- samples 48 -- samples
32 sameExample = map (similer twicePlus double) [1..10] 49 sameExample = map (similer twicePlus double) [1..10]
33 nonSameExample = map (similer twicePlus plusTwo) [1..10] 50 nonSameExample = map (similer twicePlus plusTwo) [1..10]
34 nonSameExampleSpecific = map (similer twicePlus plusTwo) [2] 51 nonSameExampleSpecific = map (similer twicePlus plusTwo) [2]
52 -}