# HG changeset patch # User Yasutaka Higa # Date 1409971532 -32400 # Node ID 116131b196bbd3bd2ab03bece625399e0d0a34e5 # Parent 88d6897c391a8e8c432b579905fc9cad85c0104c Define fmap and mu diff -r 88d6897c391a -r 116131b196bb similar.hs --- 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 -} --}