+data CCanMap a = CCanMap { cts_givder :: Map.Map a CanonicalCts
+ -- Invariant: all Given or Derived
+ , cts_wanted :: Map.Map a CanonicalCts }
+ -- Invariant: all Wanted
+cCanMapToBag :: Ord a => CCanMap a -> CanonicalCts
+cCanMapToBag cmap = Map.fold unionBags rest_cts (cts_givder cmap)
+ where rest_cts = Map.fold unionBags emptyCCan (cts_wanted cmap)
+
+emptyCCanMap :: CCanMap a
+emptyCCanMap = CCanMap { cts_givder = Map.empty, cts_wanted = Map.empty }
+
+updCCanMap:: Ord a => (a,CanonicalCt) -> CCanMap a -> CCanMap a
+updCCanMap (a,ct) cmap
+ = case cc_flavor ct of
+ Wanted {}
+ -> cmap { cts_wanted = Map.insertWith unionBags a this_ct (cts_wanted cmap) }
+ _
+ -> cmap { cts_givder = Map.insertWith unionBags a this_ct (cts_givder cmap) }
+ where this_ct = singleCCan ct
+
+getRelevantCts :: Ord a => a -> CCanMap a -> (CanonicalCts, CCanMap a)
+-- Gets the relevant constraints and returns the rest of the CCanMap
+getRelevantCts a cmap
+ = let relevant = unionBags (Map.findWithDefault emptyCCan a (cts_wanted cmap))
+ (Map.findWithDefault emptyCCan a (cts_givder cmap))
+ residual_map = cmap { cts_wanted = Map.delete a (cts_wanted cmap)
+ , cts_givder = Map.delete a (cts_givder cmap) }
+ in (relevant, residual_map)
+
+extractUnsolvedCMap :: Ord a => CCanMap a -> (CanonicalCts, CCanMap a)
+-- Gets the wanted constraints and returns a residual CCanMap
+extractUnsolvedCMap cmap =
+ let unsolved = Map.fold unionBags emptyCCan (cts_wanted cmap)
+ in (unsolved, cmap { cts_wanted = Map.empty})
+