reset a3, kut Charlie ;)
[tt2015.git] / a3 / code / Generics / GenZip.icl
diff --git a/a3/code/Generics/GenZip.icl b/a3/code/Generics/GenZip.icl
new file mode 100644 (file)
index 0000000..9f7d862
--- /dev/null
@@ -0,0 +1,44 @@
+implementation module GenZip\r
+\r
+import StdGeneric\r
+import StdEnv\r
+import StdMaybe\r
+\r
+derive bimap Maybe\r
+       \r
+generic gZip a b c :: .a .b -> .c\r
+gZip{|Int|} x y        = if (x == y) x (abort "zip Int failed\n")\r
+gZip{|Bool|} x y       = if (x == y) x (abort "zip Bool failed\n")\r
+gZip{|Char|} x y       = if (x == y) x (abort "zip Char failed\n")\r
+gZip{|Real|} x y       = if (x == y) x (abort "zip Real failed\n")\r
+gZip{|String|} x y     = if (x == y) x (abort "zip String failed\n")\r
+gZip{|UNIT|} UNIT UNIT                                         = UNIT\r
+gZip{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = PAIR (fx x1 x2) (fy y1 y2)\r
+gZip{|EITHER|} fl fr (LEFT x) (LEFT y)         = LEFT (fl x y) \r
+gZip{|EITHER|} fl fr (RIGHT x) (RIGHT y) = RIGHT (fr x y) \r
+gZip{|EITHER|} fl fr _ _                               = abort "gZip failed: EITHER does not match\n" \r
+gZip{|CONS|} f (CONS x) (CONS y)               = CONS (f x y)\r
+gZip{|FIELD|} f (FIELD x) (FIELD y)    = FIELD (f x y)\r
+gZip{|OBJECT|} f (OBJECT x) (OBJECT y)         = OBJECT (f x y)\r
+derive gZip [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
\r
+generic gMaybeZip a b c :: .a .b -> Maybe .c\r
+gMaybeZip{|Int|} x y = if (x == y) (Just x) Nothing\r
+gMaybeZip{|Bool|} x y = if (x == y) (Just x) Nothing\r
+gMaybeZip{|Char|} x y = if (x == y) (Just x) Nothing\r
+gMaybeZip{|Real|} x y = if (x == y) (Just x) Nothing\r
+gMaybeZip{|String|} x y = if (x == y) (Just x) Nothing\r
+gMaybeZip{|UNIT|} UNIT UNIT = Just UNIT\r
+gMaybeZip{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = zipMaybe PAIR (fx x1 x2) (fy y1 y2)\r
+gMaybeZip{|EITHER|} fl fr (LEFT x) (LEFT y)    = mapMaybe LEFT (fl x y)\r
+gMaybeZip{|EITHER|} fl fr (RIGHT x) (RIGHT y)          = mapMaybe RIGHT (fr x y)\r
+gMaybeZip{|EITHER|} fl fr _ _                                  = Nothing\r
+gMaybeZip{|CONS|} f (CONS x) (CONS y)                  = mapMaybe CONS (f x y)\r
+gMaybeZip{|FIELD|} f (FIELD x) (FIELD y)               = mapMaybe FIELD (f x y)\r
+gMaybeZip{|OBJECT|} f (OBJECT x) (OBJECT y)    = mapMaybe OBJECT (f x y)\r
+derive gMaybeZip [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)\r
+\r
+zipMaybe :: .(.a -> .(.b -> .c)) !(Maybe .a) (Maybe .b) -> (Maybe .c)\r
+zipMaybe f (Just x) (Just y)   = Just (f x y)\r
+zipMaybe f _ _                                         = Nothing\r
+\r