# HG changeset patch # User Yasutaka Higa # Date 1410236983 -32400 # Node ID 4b315cf0edb97c0fdfa88d368ede29672c7c9903 # Parent c599d2236d193a378d7fa133b377d63403124893 Improve mu definition diff -r c599d2236d19 -r 4b315cf0edb9 similar.hs --- a/similar.hs Sat Sep 06 16:01:27 2014 +0900 +++ b/similar.hs Tue Sep 09 13:29:43 2014 +0900 @@ -11,21 +11,17 @@ value (Single x) = x value (Similar x s) = value s -toList :: Similar a -> [a] -toList (Single x) = [x] -toList (Similar x s) = x : (toList s) - -toSimilar :: [a] -> Similar a -toSimilar [] = undefined -toSimilar (x:[]) = Single x -toSimilar (x:xs) = Similar x (toSimilar xs) +similar :: Similar a -> Similar a -> Similar a +similar (Single x) ss = Similar x ss +similar (Similar x s) ss = Similar x (similar s ss) instance Functor Similar where fmap f (Single a) = Single (f a) fmap f (Similar a s) = Similar (f a) (fmap f s) mu :: (Similar (Similar a)) -> Similar a -mu s = toSimilar \$ concat \$ toList \$ fmap (toList) s +mu (Single s) = s +mu (Similar s ss) = similar s (mu ss) instance Monad Similar where return = Single @@ -33,6 +29,7 @@ (Similar x s) >>= f = mu \$ Similar (f x) (fmap f s) +-- samples double :: Int -> Similar Int double x = Single (2 * x) @@ -73,9 +70,9 @@ *Main> same \$ return 100 >>= double >>= twicePlus 400 -*Main> same \$ return 100 >>= double >>= twicePlus >>= plusTwo +*Main> same \$ return 100 >>= double >>= twicePlus >>= plusTwo *** Exception: same -*Main> value \$ return 100 >>= double >>= twicePlus >>= plusTwo +*Main> value \$ return 100 >>= double >>= twicePlus >>= plusTwo 800 -}