| 15 | |

| 16 | |

| 17 | |

| 18 | Generic finite maps: |

| 19 | |

| 20 | {{{ |

| 21 | class GMapKey k where |

| 22 | data GMap k :: * -> * |

| 23 | empty :: GMap k v |

| 24 | lookup :: k -> GMap k v -> Maybe v |

| 25 | insert :: k -> v -> GMap k v -> GMap k v |

| 26 | |

| 27 | instance GMapKey Int where |

| 28 | data GMap Int v = GMapInt (Map.Map Int v) |

| 29 | empty = GMapInt Map.empty |

| 30 | lookup k (GMapInt m) = Map.lookup k m |

| 31 | insert k v (GMapInt m) = GMapInt (Map.insert k v m) |

| 32 | |

| 33 | instance GMapKey Char where |

| 34 | data GMap Char v = GMapChar (GMap Int v) |

| 35 | empty = GMapChar empty |

| 36 | lookup k (GMapChar m) = lookup (ord k) m |

| 37 | insert k v (GMapChar m) = GMapChar (insert (ord k) v m) |

| 38 | |

| 39 | instance GMapKey () where |

| 40 | data GMap () v = GMapUnit (Maybe v) |

| 41 | empty = GMapUnit Nothing |

| 42 | lookup () (GMapUnit v) = v |

| 43 | insert () v (GMapUnit _) = GMapUnit $ Just v |

| 44 | |

| 45 | instance (GMapKey a, GMapKey b) => GMapKey (a, b) where |

| 46 | data GMap (a, b) v = GMapPair (GMap a (GMap b v)) |

| 47 | empty = GMapPair empty |

| 48 | lookup (a, b) (GMapPair gm) = lookup a gm >>= lookup b |

| 49 | insert (a, b) v (GMapPair gm) = GMapPair $ case lookup a gm of |

| 50 | Nothing -> insert a (insert b v empty) gm |

| 51 | Just gm2 -> insert a (insert b v gm2 ) gm |

| 52 | |

| 53 | instance (GMapKey a, GMapKey b) => GMapKey (Either a b) where |

| 54 | data GMap (Either a b) v = GMapEither (GMap a v) (GMap b v) |

| 55 | empty = GMapEither empty empty |

| 56 | lookup (Left a) (GMapEither gm1 _gm2) = lookup a gm1 |

| 57 | lookup (Right b) (GMapEither _gm1 gm2 ) = lookup b gm2 |

| 58 | insert (Left a) v (GMapEither gm1 gm2) = GMapEither (insert a v gm1) gm2 |

| 59 | insert (Right a) v (GMapEither gm1 gm2) = GMapEither gm1 (insert a v gm2) |

| 60 | }}} |

| 61 | |