a3/code/Generics/GenZip.icl

   1 implementation module GenZip
   2
   3 import StdGeneric
   4 import StdEnv
   5 import StdMaybe
   6
   7 derive bimap Maybe
   8
   9 generic gZip a b c :: .a .b -> .c
  10 gZip{|Int|} x y         = if (x == y) x (abort "zip Int failed\n")
  11 gZip{|Bool|} x y        = if (x == y) x (abort "zip Bool failed\n")
  12 gZip{|Char|} x y        = if (x == y) x (abort "zip Char failed\n")
  13 gZip{|Real|} x y        = if (x == y) x (abort "zip Real failed\n")
  14 gZip{|String|} x y      = if (x == y) x (abort "zip String failed\n")
  15 gZip{|UNIT|} UNIT UNIT                                  = UNIT
  16 gZip{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = PAIR (fx x1 x2) (fy y1 y2)
  17 gZip{|EITHER|} fl fr (LEFT x) (LEFT y)  = LEFT (fl x y)
  18 gZip{|EITHER|} fl fr (RIGHT x) (RIGHT y) = RIGHT (fr x y)
  19 gZip{|EITHER|} fl fr _ _                                = abort "gZip failed: EITHER does not match\n"
  20 gZip{|CONS|} f (CONS x) (CONS y)                = CONS (f x y)
  21 gZip{|FIELD|} f (FIELD x) (FIELD y)     = FIELD (f x y)
  22 gZip{|OBJECT|} f (OBJECT x) (OBJECT y)  = OBJECT (f x y)
  23 derive gZip [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
  24
  25 generic gMaybeZip a b c :: .a .b -> Maybe .c
  26 gMaybeZip{|Int|} x y = if (x == y) (Just x) Nothing
  27 gMaybeZip{|Bool|} x y = if (x == y) (Just x) Nothing
  28 gMaybeZip{|Char|} x y = if (x == y) (Just x) Nothing
  29 gMaybeZip{|Real|} x y = if (x == y) (Just x) Nothing
  30 gMaybeZip{|String|} x y = if (x == y) (Just x) Nothing
  31 gMaybeZip{|UNIT|} UNIT UNIT = Just UNIT
  32 gMaybeZip{|PAIR|} fx fy (PAIR x1 y1) (PAIR x2 y2) = zipMaybe PAIR (fx x1 x2) (fy y1 y2)
  33 gMaybeZip{|EITHER|} fl fr (LEFT x) (LEFT y)     = mapMaybe LEFT (fl x y)
  34 gMaybeZip{|EITHER|} fl fr (RIGHT x) (RIGHT y)   = mapMaybe RIGHT (fr x y)
  35 gMaybeZip{|EITHER|} fl fr _ _                                   = Nothing
  36 gMaybeZip{|CONS|} f (CONS x) (CONS y)                   = mapMaybe CONS (f x y)
  37 gMaybeZip{|FIELD|} f (FIELD x) (FIELD y)                = mapMaybe FIELD (f x y)
  38 gMaybeZip{|OBJECT|} f (OBJECT x) (OBJECT y)     = mapMaybe OBJECT (f x y)
  39 derive gMaybeZip [], (,), (,,),  (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
  40
  41 zipMaybe :: .(.a -> .(.b -> .c)) !(Maybe .a) (Maybe .b) -> (Maybe .c)
  42 zipMaybe f (Just x) (Just y)    = Just (f x y)
  43 zipMaybe f _ _                                  = Nothing
  44