# HG changeset patch # User Yasutaka Higa # Date 1411436333 -32400 # Node ID d4aa70d9435249dc89772afcbc04dc8f8a662b94 # Parent 003b6e58d815a399e2c9004aef9d1ea6e3b7e54b Define Similar as Applicative diff -r 003b6e58d815 -r d4aa70d94352 similar.hs --- a/similar.hs Mon Sep 22 23:26:51 2014 +0900 +++ b/similar.hs Tue Sep 23 10:38:53 2014 +0900 @@ -14,6 +14,15 @@ fmap f (Single xs x) = Single xs (f x) fmap f (Similar xs x ys y) = Similar xs (f x) ys (f y) +instance Applicative Similar where + pure = Single [] + (Single lf f) <*> (Single lx x) = Single (lf ++ lx) (f x) + (Single lf f) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lf ++ ly) (f y) + (Similar lf f lg g) <*> (Single lx x) = Similar (lf ++ lx) (f x) (lg ++ lx) (g x) + (Similar lf f lg g) <*> (Similar lx x ly y) = Similar (lf ++ lx) (f x) (lg ++ ly) (g y) + + + mu :: Similar (Similar a) -> Similar a mu (Single ls (Single lx x)) = Single (ls ++ lx) x mu (Single ls (Similar lx x ly y)) = Similar (ls ++ lx) x (ls ++ ly) y