# HG changeset patch # User Yasutaka Higa # Date 1409644792 -32400 # Node ID 158ae705cd16c7507d3ce0c673e6b7cbd6f64e0f # Parent e8a5df54480e1ef766d9d09d6a93aad62efc56ef Rename Similer -> Similar diff -r e8a5df54480e -r 158ae705cd16 similar.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/similar.hs Tue Sep 02 16:59:52 2014 +0900 @@ -0,0 +1,55 @@ +{-# LANGUAGE GADTs #-} + +data Similar a = (Eq a) => Similar a (a -> a) a + +instance (Eq a) => Eq (Similar a) where + s == ss = same s == same ss + +same :: (Eq a) => Similar a -> a +same (Similar x f y) = if (f x) == y then y else undefined + +mu :: (Eq a) => Similar (Similar a) -> Similar a +mu (Similar a f b) = if ((f a) == b) then b else undefined + +class EqFunctor f where + eqmap :: (Eq a, Eq b) => (a -> b) -> f a -> f b + +instance EqFunctor Similar where + eqmap f s = Similar fs id fs + where fs = f $ same s + +class EqMonad m where + (>>=) :: (Eq a, Eq b) => m a -> (a -> m b) -> m b + return ::(Eq a) => a -> m a + +instance EqMonad Similar where + return x = Similar x id x + s >>= f = mu (eqmap f s) + +similar :: (Eq a) => (a -> a) -> (a -> a) -> a -> a +similar f g x = same $ Similar x g (f x) + + + +double :: Int -> Int +double x = (2 * x) + +twicePlus :: Int -> Int +twicePlus x = x + x + +plusTwo :: Int -> Int +plusTwo x = x + 2 + +-- samples + +{- +*Main> same $ Main.return 100 Main.>>= (\x -> Similar x twicePlus $ double x) +200 + +*Main> same $ Main.return 2 Main.>>= (\x -> Similar x plusTwo $ double x) +4 + +*Main> same $ Main.return 100 Main.>>= (\x -> Similar x plusTwo $ double x) +*** Exception: Prelude.undefined +-} + diff -r e8a5df54480e -r 158ae705cd16 similer.hs --- a/similer.hs Tue Sep 02 16:25:53 2014 +0900 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,54 +0,0 @@ -{-# LANGUAGE GADTs #-} - -data Similer a = (Eq a) => Similer a (a -> a) a - -instance (Eq a) => Eq (Similer a) where - s == ss = same s == same ss - -same :: (Eq a) => Similer a -> a -same (Similer x f y) = if (f x) == y then y else undefined - -mu :: (Eq a) => Similer (Similer a) -> Similer a -mu (Similer a f b) = if ((f a) == b) then b else undefined - -class EqFunctor f where - eqmap :: (Eq a, Eq b) => (a -> b) -> f a -> f b - -instance EqFunctor Similer where - eqmap f s = Similer fs id fs - where fs = f $ same s - -class EqMonad m where - (>>=) :: (Eq a, Eq b) => m a -> (a -> m b) -> m b - return ::(Eq a) => a -> m a - -instance EqMonad Similer where - return x = Similer x id x - s >>= f = mu (eqmap f s) - -similer :: (Eq a) => (a -> a) -> (a -> a) -> a -> a -similer f g x = same $ Similer x g (f x) - - - -double :: Int -> Int -double x = (2 * x) - -twicePlus :: Int -> Int -twicePlus x = x + x - -plusTwo :: Int -> Int -plusTwo x = x + 2 - --- samples - -{- -*Main> same $ Main.return 100 Main.>>= (\x -> Similer x twicePlus $ double x) -200 - -*Main> same $ Main.return 2 Main.>>= (\x -> Similer x plusTwo $ double x) -4 - -*Main> same $ Main.return 100 Main.>>= (\x -> Similer x plusTwo $ double x) -*** Exception: Prelude.undefined --}