Mercurial > hg > Members > atton > delta_monad
changeset 14:116131b196bb
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 |
files | similar.hs |
diffstat | 1 files changed, 21 insertions(+), 17 deletions(-) [+] |
line wrap: on
line diff
--- a/similar.hs Sat Sep 06 11:03:34 2014 +0900 +++ b/similar.hs Sat Sep 06 11:45:32 2014 +0900 @@ -1,34 +1,39 @@ -data Similar a = Single a | Similar a (Similar a) +data Similar a = Single a | Similar a (Similar a) deriving (Show) + +instance (Eq a) => Eq (Similar a) where + s == ss = (same s) == (same ss) same :: (Eq a) => Similar a -> a same (Single x) = x -same (Similar x s) = if x == (same s) then x else undefined +same (Similar x s) = if x == (same s) then x else (error "same") -instance (Eq a) => Eq (Similar a) where - s == ss = (same s) == (same ss) instance Functor Similar where fmap f (Single a) = Single (f a) fmap f (Similar a s) = Similar (f a) (fmap f s) -{- +mu :: (Eq a) => (Similar (Similar a)) -> Similar a +mu (Single x) = x +mu (Similar (Single x) s) = Similar x (mu s) +mu (Similar s ss) = Similar (same s) (mu ss) -mu :: (Eq a) => Similar (Similar a) -> Similar a -mu (Similar a f b) = if ((f a) == b) then b else undefined - -similar :: (Eq a) => (a -> a) -> (a -> a) -> a -> a -similar f g x = same $ Similar x g (f x) +{- +instance Monad Similar where + return = Single + (Single x) >>= f = f x + (Similar x s) >>= f = mu $ Similar (f x) (fmap f s) +-} -double :: Int -> Int -double x = (2 * x) +double :: Int -> Similar Int +double x = Single (2 * x) -twicePlus :: Int -> Int -twicePlus x = x + x +twicePlus :: Int -> Similar Int +twicePlus x = Similar (x + x) (double x) -plusTwo :: Int -> Int -plusTwo x = x + 2 +plusTwo :: Int -> Similar Int +plusTwo x = Similar (x + 2) (double x) -- samples @@ -43,4 +48,3 @@ *** Exception: Prelude.undefined -} --}