# HG changeset patch
# User Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
# 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
 
 -}