Mercurial > hg > Members > atton > similar_monad

changeset 20:d4aa70d94352

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Define Similar as Applicative
author Yasutaka Higa <e115763@ie.u-ryukyu.ac.jp>
date Tue, 23 Sep 2014 10:38:53 +0900
parents 003b6e58d815
children af8754322ed4
files similar.hs
diffstat 1 files changed, 9 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- 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