Rename methods of IsSet and IsMap.
authorMilan Straka <fox@ucw.cz>
Mon, 3 May 2010 18:44:08 +0000 (19:44 +0100)
committerMilan Straka <fox@ucw.cz>
Mon, 3 May 2010 18:44:08 +0000 (19:44 +0100)
Use prefix instead of suffix, ie. setUnion, setElems etc.
Also we have now
  type ElemOf set
and
  type KeyOf map

12 files changed:
src/Compiler/Hoopl/Collections.hs
src/Compiler/Hoopl/Combinators.hs
src/Compiler/Hoopl/Dataflow.hs
src/Compiler/Hoopl/Graph.hs
src/Compiler/Hoopl/GraphUtil.hs
src/Compiler/Hoopl/Label.hs
src/Compiler/Hoopl/MkGraph.hs
src/Compiler/Hoopl/Passes/Dominator.hs
src/Compiler/Hoopl/Show.hs
src/Compiler/Hoopl/Unique.hs
src/Compiler/Hoopl/Util.hs
src/Compiler/Hoopl/XUtil.hs

index 5c42826..199ed44 100644 (file)
@@ -2,82 +2,84 @@
 
 {-# LANGUAGE TypeFamilies #-}
 module Compiler.Hoopl.Collections ( IsSet(..)
+                                  , setInsertList, setDeleteList, setUnions
                                   , IsMap(..)
+                                  , mapInsertList, mapDeleteList, mapUnions
                                   ) where
 
 import Data.List (foldl', foldl1')
 
 class IsSet set where
-  type KeySet set
+  type ElemOf set
 
-  nullSet :: set -> Bool
-  sizeSet :: set -> Int
-  memberSet :: KeySet set -> set -> Bool
+  setNull :: set -> Bool
+  setSize :: set -> Int
+  setMember :: ElemOf set -> set -> Bool
 
-  emptySet :: set
-  singletonSet :: KeySet set -> set
-  insertSet :: KeySet set -> set -> set
-  deleteSet :: KeySet set -> set -> set
+  setEmpty :: set
+  setSingleton :: ElemOf set -> set
+  setInsert :: ElemOf set -> set -> set
+  setDelete :: ElemOf set -> set -> set
 
-  unionSet :: set -> set -> set
-  differenceSet :: set -> set -> set
-  intersectionSet :: set -> set -> set
-  isSubsetOfSet :: set -> set -> Bool
+  setUnion :: set -> set -> set
+  setDifference :: set -> set -> set
+  setIntersection :: set -> set -> set
+  setIsSubsetOf :: set -> set -> Bool
 
-  foldSet :: (KeySet set -> b -> b) -> b -> set -> b
+  setFold :: (ElemOf set -> b -> b) -> b -> set -> b
 
-  elemsSet :: set -> [KeySet set]
-  fromListSet :: [KeySet set] -> set
+  setElems :: set -> [ElemOf set]
+  setFromList :: [ElemOf set] -> set
 
-  -- and some derived functions
-  insertListSet :: [KeySet set] -> set -> set
-  insertListSet keys set = foldl' (flip insertSet) set keys
+-- Helper functions for IsSet class
+setInsertList :: IsSet set => [ElemOf set] -> set -> set
+setInsertList keys set = foldl' (flip setInsert) set keys
 
-  deleteListSet :: [KeySet set] -> set -> set
-  deleteListSet keys set = foldl' (flip deleteSet) set keys
+setDeleteList :: IsSet set => [ElemOf set] -> set -> set
+setDeleteList keys set = foldl' (flip setDelete) set keys
 
-  unionsSet :: [set] -> set
-  unionsSet [] = emptySet
-  unionsSet sets = foldl1' unionSet sets
+setUnions :: IsSet set => [set] -> set
+setUnions [] = setEmpty
+setUnions sets = foldl1' setUnion sets
 
 
 class IsMap map where
-  type KeyMap map
+  type KeyOf map
 
-  nullMap :: map a -> Bool
-  sizeMap :: map a -> Int
-  memberMap :: KeyMap map -> map a -> Bool
-  lookupMap :: KeyMap map -> map a -> Maybe a
-  findWithDefaultMap :: a -> KeyMap map -> map a -> a
+  mapNull :: map a -> Bool
+  mapSize :: map a -> Int
+  mapMember :: KeyOf map -> map a -> Bool
+  mapLookup :: KeyOf map -> map a -> Maybe a
+  mapFindWithDefault :: a -> KeyOf map -> map a -> a
 
-  emptyMap :: map a
-  singletonMap :: KeyMap map -> a -> map a
-  insertMap :: KeyMap map -> a -> map a -> map a
-  deleteMap :: KeyMap map -> map a -> map a
+  mapEmpty :: map a
+  mapSingleton :: KeyOf map -> a -> map a
+  mapInsert :: KeyOf map -> a -> map a -> map a
+  mapDelete :: KeyOf map -> map a -> map a
 
-  unionMap :: map a -> map a -> map a
-  unionWithKeyMap :: (KeyMap map -> a -> a -> a) -> map a -> map a -> map a
-  differenceMap :: map a -> map a -> map a
-  intersectionMap :: map a -> map a -> map a
-  isSubmapOfMap :: Eq a => map a -> map a -> Bool
+  mapUnion :: map a -> map a -> map a
+  mapUnionWithKey :: (KeyOf map -> a -> a -> a) -> map a -> map a -> map a
+  mapDifference :: map a -> map a -> map a
+  mapIntersection :: map a -> map a -> map a
+  mapIsSubmapOf :: Eq a => map a -> map a -> Bool
 
   mapMap :: (a -> b) -> map a -> map b
-  mapWithKeyMap :: (KeyMap map -> a -> b) -> map a -> map b
-  foldMap :: (a -> b -> b) -> b -> map a -> b
-  foldWithKeyMap :: (KeyMap map -> a -> b -> b) -> b -> map a -> b
+  mapMapWithKey :: (KeyOf map -> a -> b) -> map a -> map b
+  mapFold :: (a -> b -> b) -> b -> map a -> b
+  mapFoldWithKey :: (KeyOf map -> a -> b -> b) -> b -> map a -> b
 
-  elemsMap :: map a -> [a]
-  keysMap :: map a -> [KeyMap map]
-  toListMap :: map a -> [(KeyMap map, a)]
-  fromListMap :: [(KeyMap map, a)] -> map a
+  mapElems :: map a -> [a]
+  mapKeys :: map a -> [KeyOf map]
+  mapToList :: map a -> [(KeyOf map, a)]
+  mapFromList :: [(KeyOf map, a)] -> map a
 
-  -- and some derived functions
-  insertListMap :: [(KeyMap map, a)] -> map a -> map a
-  insertListMap assocs map = foldl' (flip (uncurry insertMap)) map assocs
+-- Helper functions for IsMap class
+mapInsertList :: IsMap map => [(KeyOf map, a)] -> map a -> map a
+mapInsertList assocs map = foldl' (flip (uncurry mapInsert)) map assocs
 
-  deleteListMap :: [KeyMap map] -> map a -> map a
-  deleteListMap keys map = foldl' (flip deleteMap) map keys
+mapDeleteList :: IsMap map => [KeyOf map] -> map a -> map a
+mapDeleteList keys map = foldl' (flip mapDelete) map keys
 
-  unionsMap :: [map a] -> map a
-  unionsMap [] = emptyMap
-  unionsMap maps = foldl1' unionMap maps
+mapUnions :: IsMap map => [map a] -> map a
+mapUnions [] = mapEmpty
+mapUnions maps = foldl1' mapUnion maps
index 6a06272..585b5c1 100644 (file)
@@ -175,7 +175,7 @@ productFwd pass1 pass2 = FwdPass lattice transfer rewrite
     transfer = mkFTransfer (tf tf1 tf2) (tf tm1 tm2) (tfb tl1 tl2)
       where
         tf  t1 t2 n (f1, f2) = (t1 n f1, t2 n f2)
-        tfb t1 t2 n (f1, f2) = mapWithKeyMap withfb2 fb1
+        tfb t1 t2 n (f1, f2) = mapMapWithKey withfb2 fb1
           where fb1 = t1 n f1
                 fb2 = t2 n f2
                 withfb2 l f = (f, fromMaybe bot2 $ lookupFact l fb2)
index d9f37a8..47902e9 100644 (file)
@@ -256,7 +256,7 @@ arfGraph pass entries = graph
         forwardBlockList entries blocks
       where
         do_block b f = do (g, fb) <- block b $ lookupF pass (entryLabel b) f
-                          return (g, toListMap fb)
+                          return (g, mapToList fb)
 
 
 
@@ -265,7 +265,7 @@ arfGraph pass entries = graph
 -- functions might, for example, generate some debugging traces.
 joinInFacts :: DataflowLattice f -> FactBase f -> FactBase f
 joinInFacts (DataflowLattice {fact_bot = bot, fact_extend = fe}) fb =
-  mkFactBase $ map botJoin $ toListMap fb
+  mkFactBase $ map botJoin $ mapToList fb
     where botJoin (l, f) = (l, snd $ fe l (OldFact bot) (NewFact f))
 
 forwardBlockList :: (Edges n, LabelsPtr entry)
@@ -465,7 +465,7 @@ updateFact :: DataflowLattice f -> LabelSet -> (Label, f)
 -- See Note [TxFactBase change flag]
 updateFact lat lbls (lbl, new_fact) (cha, fbase)
   | NoChange <- cha2     = (cha,        fbase)
-  | lbl `memberSet` lbls = (SomeChange, new_fbase)
+  | lbl `setMember` lbls = (SomeChange, new_fbase)
   | otherwise            = (cha,        new_fbase)
   where
     (cha2, res_fact) -- Note [Unreachable blocks]
@@ -473,7 +473,7 @@ updateFact lat lbls (lbl, new_fact) (cha, fbase)
            Nothing -> (SomeChange, snd $ join $ fact_bot lat)  -- Note [Unreachable blocks]
            Just old_fact -> join old_fact
          where join old_fact = fact_extend lat lbl (OldFact old_fact) (NewFact new_fact)
-    new_fbase = insertMap lbl res_fact fbase
+    new_fbase = mapInsert lbl res_fact fbase
 
 fixpoint :: forall m block n f. (FuelMonad m, Edges n, Edges (block n))
          => Bool       -- Going forwards?
@@ -486,7 +486,7 @@ fixpoint is_fwd lat do_block init_fbase untagged_blocks
   = do { fuel <- getFuel  
        ; tx_fb <- loop fuel init_fbase
        ; return (tfb_rg tx_fb, 
-                 map (fst . fst) blocks `deleteListMap` tfb_fbase tx_fb ) }
+                 map (fst . fst) blocks `mapDeleteList` tfb_fbase tx_fb ) }
             -- The successors of the Graph are the the Labels for which
             -- we have facts, that are *not* in the blocks of the graph
   where
@@ -503,13 +503,13 @@ fixpoint is_fwd lat do_block init_fbase untagged_blocks
              -> TxFactBase n f -> m (TxFactBase n f)
     tx_block lbl blk deps tx_fb@(TxFB { tfb_fbase = fbase, tfb_lbls = lbls
                                       , tfb_rg = blks, tfb_cha = cha })
-      | is_fwd && not (lbl `memberMap` fbase)
-      = return tx_fb {tfb_lbls = lbls `unionSet` fromListSet deps}     -- Note [Unreachable blocks]
+      | is_fwd && not (lbl `mapMember` fbase)
+      = return tx_fb {tfb_lbls = lbls `setUnion` setFromList deps}     -- Note [Unreachable blocks]
       | otherwise
       = do { (rg, out_facts) <- do_block blk fbase
            ; let (cha',fbase') 
                    = foldr (updateFact lat lbls) (cha,fbase) out_facts
-                 lbls' = lbls `unionSet` fromListSet deps
+                 lbls' = lbls `setUnion` setFromList deps
            ; return (TxFB { tfb_lbls  = lbls'
                           , tfb_rg    = rg `rgCat` blks
                           , tfb_fbase = fbase', tfb_cha = cha' }) }
@@ -519,7 +519,7 @@ fixpoint is_fwd lat do_block init_fbase untagged_blocks
       = do { let init_tx_fb = TxFB { tfb_fbase = fbase
                                    , tfb_cha   = NoChange
                                    , tfb_rg    = rgnilC
-                                   , tfb_lbls  = emptySet }
+                                   , tfb_lbls  = setEmpty }
            ; tx_fb <- tx_blocks blocks init_tx_fb
            ; case tfb_cha tx_fb of
                NoChange   -> return tx_fb
@@ -592,13 +592,13 @@ normalizeGraph g = (graphMapBlocks dropFact g, facts g)
           facts :: RG f n e x -> FactBase f
           facts GNil = noFacts
           facts (GUnit _) = noFacts
-          facts (GMany _ body exit) = bodyFacts body `unionMap` exitFacts exit
+          facts (GMany _ body exit) = bodyFacts body `mapUnion` exitFacts exit
           exitFacts :: MaybeO x (FBlock f n C O) -> FactBase f
           exitFacts NothingO = noFacts
           exitFacts (JustO (FBlock f b)) = mkFactBase [(entryLabel b, f)]
           bodyFacts :: Body' (FBlock f) n -> FactBase f
-          bodyFacts (Body body) = foldMap f noFacts body
-            where f (FBlock f b) fb = insertMap (entryLabel b) f fb
+          bodyFacts (Body body) = mapFold f noFacts body
+            where f (FBlock f b) fb = mapInsert (entryLabel b) f fb
 
 --- implementation of the constructors (boring)
 
index e50b041..1711125 100644 (file)
@@ -99,10 +99,10 @@ instance Edges n => Edges (Block n) where
 
 ------------------------------
 emptyBody :: Body' block n
-emptyBody = Body emptyMap
+emptyBody = Body mapEmpty
 
 addBlock :: Edges (block n) => block n C C -> Body' block n -> Body' block n
-addBlock b (Body body) = Body (insertMap (entryLabel b) b body)
+addBlock b (Body body) = Body (mapInsert (entryLabel b) b body)
 
 bodyList :: Edges (block n) => Body' block n -> [(Label,block n C C)]
-bodyList (Body body) = toListMap body
+bodyList (Body body) = mapToList body
index 79f6e5f..2730ea6 100644 (file)
@@ -32,11 +32,11 @@ splice bcat = sp
         sp (GMany e bs (JustO x)) (GUnit b2) = GMany e bs (JustO (x `bcat` b2))
 
         sp (GMany e1 bs1 (JustO x1)) (GMany (JustO e2) (Body b2) x2)
-          = GMany e1 (Body $ unionMap b1 b2) x2
+          = GMany e1 (Body $ mapUnion b1 b2) x2
           where (Body b1) = addBlock (x1 `bcat` e2) bs1
 
         sp (GMany e1 (Body b1) NothingO) (GMany NothingO (Body b2) x2)
-           = GMany e1 (Body $ unionMap b1 b2) x2
+           = GMany e1 (Body $ mapUnion b1 b2) x2
 
         sp _ _ = error "bogus GADT match failure"
 
index b21af83..10a10d0 100644 (file)
@@ -36,26 +36,26 @@ freshLabel = freshUnique >>= return . uniqueToLbl
 newtype LabelSet = LS UniqueSet deriving (Eq, Ord, Show)
 
 instance IsSet LabelSet where
-  type KeySet LabelSet = Label
+  type ElemOf LabelSet = Label
 
-  nullSet (LS s) = nullSet s
-  sizeSet (LS s) = sizeSet s
-  memberSet (Label k) (LS s) = memberSet k s
+  setNull (LS s) = setNull s
+  setSize (LS s) = setSize s
+  setMember (Label k) (LS s) = setMember k s
 
-  emptySet = LS emptySet
-  singletonSet (Label k) = LS (singletonSet k)
-  insertSet (Label k) (LS s) = LS (insertSet k s)
-  deleteSet (Label k) (LS s) = LS (deleteSet k s)
+  setEmpty = LS setEmpty
+  setSingleton (Label k) = LS (setSingleton k)
+  setInsert (Label k) (LS s) = LS (setInsert k s)
+  setDelete (Label k) (LS s) = LS (setDelete k s)
 
-  unionSet (LS x) (LS y) = LS (unionSet x y)
-  differenceSet (LS x) (LS y) = LS (differenceSet x y)
-  intersectionSet (LS x) (LS y) = LS (intersectionSet x y)
-  isSubsetOfSet (LS x) (LS y) = isSubsetOfSet x y
+  setUnion (LS x) (LS y) = LS (setUnion x y)
+  setDifference (LS x) (LS y) = LS (setDifference x y)
+  setIntersection (LS x) (LS y) = LS (setIntersection x y)
+  setIsSubsetOf (LS x) (LS y) = setIsSubsetOf x y
 
-  foldSet k z (LS s) = foldSet (k . uniqueToLbl) z s
+  setFold k z (LS s) = setFold (k . uniqueToLbl) z s
 
-  elemsSet (LS s) = map uniqueToLbl (elemsSet s)
-  fromListSet ks = LS (fromListSet (map lblToUnique ks))
+  setElems (LS s) = map uniqueToLbl (setElems s)
+  setFromList ks = LS (setFromList (map lblToUnique ks))
 
 -----------------------------------------------------------------------------
 -- LabelMap
@@ -63,34 +63,34 @@ instance IsSet LabelSet where
 newtype LabelMap v = LM (UniqueMap v) deriving (Eq, Ord, Show)
 
 instance IsMap LabelMap where
-  type KeyMap LabelMap = Label
+  type KeyOf LabelMap = Label
 
-  nullMap (LM m) = nullMap m
-  sizeMap (LM m) = sizeMap m
-  memberMap (Label k) (LM m) = memberMap k m
-  lookupMap (Label k) (LM m) = lookupMap k m
-  findWithDefaultMap def (Label k) (LM m) = findWithDefaultMap def k m
+  mapNull (LM m) = mapNull m
+  mapSize (LM m) = mapSize m
+  mapMember (Label k) (LM m) = mapMember k m
+  mapLookup (Label k) (LM m) = mapLookup k m
+  mapFindWithDefault def (Label k) (LM m) = mapFindWithDefault def k m
 
-  emptyMap = LM emptyMap
-  singletonMap (Label k) v = LM (singletonMap k v)
-  insertMap (Label k) v (LM m) = LM (insertMap k v m)
-  deleteMap (Label k) (LM m) = LM (deleteMap k m)
+  mapEmpty = LM mapEmpty
+  mapSingleton (Label k) v = LM (mapSingleton k v)
+  mapInsert (Label k) v (LM m) = LM (mapInsert k v m)
+  mapDelete (Label k) (LM m) = LM (mapDelete k m)
 
-  unionMap (LM x) (LM y) = LM (unionMap x y)
-  unionWithKeyMap f (LM x) (LM y) = LM (unionWithKeyMap (f . uniqueToLbl) x y)
-  differenceMap (LM x) (LM y) = LM (differenceMap x y)
-  intersectionMap (LM x) (LM y) = LM (intersectionMap x y)
-  isSubmapOfMap (LM x) (LM y) = isSubmapOfMap x y
+  mapUnion (LM x) (LM y) = LM (mapUnion x y)
+  mapUnionWithKey f (LM x) (LM y) = LM (mapUnionWithKey (f . uniqueToLbl) x y)
+  mapDifference (LM x) (LM y) = LM (mapDifference x y)
+  mapIntersection (LM x) (LM y) = LM (mapIntersection x y)
+  mapIsSubmapOf (LM x) (LM y) = mapIsSubmapOf x y
 
   mapMap f (LM m) = LM (mapMap f m)
-  mapWithKeyMap f (LM m) = LM (mapWithKeyMap (f . uniqueToLbl) m)
-  foldMap k z (LM m) = foldMap k z m
-  foldWithKeyMap k z (LM m) = foldWithKeyMap (k . uniqueToLbl) z m
+  mapMapWithKey f (LM m) = LM (mapMapWithKey (f . uniqueToLbl) m)
+  mapFold k z (LM m) = mapFold k z m
+  mapFoldWithKey k z (LM m) = mapFoldWithKey (k . uniqueToLbl) z m
 
-  elemsMap (LM m) = elemsMap m
-  keysMap (LM m) = map uniqueToLbl (keysMap m)
-  toListMap (LM m) = [(uniqueToLbl k, v) | (k, v) <- toListMap m]
-  fromListMap assocs = LM (fromListMap [(lblToUnique k, v) | (k, v) <- assocs])
+  mapElems (LM m) = mapElems m
+  mapKeys (LM m) = map uniqueToLbl (mapKeys m)
+  mapToList (LM m) = [(uniqueToLbl k, v) | (k, v) <- mapToList m]
+  mapFromList assocs = LM (mapFromList [(lblToUnique k, v) | (k, v) <- assocs])
 
 -----------------------------------------------------------------------------
 -- FactBase
@@ -98,10 +98,10 @@ instance IsMap LabelMap where
 type FactBase f = LabelMap f
 
 noFacts :: FactBase f
-noFacts = emptyMap
+noFacts = mapEmpty
 
 mkFactBase :: [(Label, f)] -> FactBase f
-mkFactBase = fromListMap
+mkFactBase = mapFromList
 
 lookupFact :: Label -> FactBase f -> Maybe f
-lookupFact = lookupMap
+lookupFact = mapLookup
index 94b529f..70aacb0 100644 (file)
@@ -160,7 +160,7 @@ addBlocks (A g) (A blocks) = A $ g >>= \g -> blocks >>= add g
   where add :: (UniqueMonad m, HooplNode n)
             => Graph n e x -> Graph n C C -> m (Graph n e x)
         add (GMany e (Body body) x) (GMany NothingO (Body body') NothingO) =
-          return $ GMany e (Body $ unionMap body body') x
+          return $ GMany e (Body $ mapUnion body body') x
         add g@GNil      blocks = spliceOO g blocks
         add g@(GUnit _) blocks = spliceOO g blocks
         spliceOO :: (HooplNode n, UniqueMonad m)
index fba9fea..180e267 100644 (file)
@@ -84,12 +84,12 @@ tree facts = Dominates Entry $ merge $ map reverse $ map mkList facts
   where merge lists = mapTree $ children $ filter (not . null) lists
         children = foldl addList noFacts
         addList :: FactBase [[Label]] -> [Label] -> FactBase [[Label]]
-        addList map (x:xs) = insertMap x (xs:existing) map
+        addList map (x:xs) = mapInsert x (xs:existing) map
             where existing = fromMaybe [] $ lookupFact x map
         addList _ [] = error "this can't happen"
         mapTree :: FactBase [[Label]] -> [DominatorTree]
         mapTree map = [Dominates (Labelled x) (merge lists) |
-                                                    (x, lists) <- toListMap map]
+                                                    (x, lists) <- mapToList map]
         mkList (l, doms) = l : domPath doms
 
 
index 21495bb..8e87096 100644 (file)
@@ -38,4 +38,4 @@ open _ NothingO  = ""
 open p (JustO n) = p n
 
 showFactBase :: Show f => FactBase f -> String
-showFactBase = show . toListMap
+showFactBase = show . mapToList
index f4ae68b..495d3af 100644 (file)
@@ -35,26 +35,26 @@ instance Show Unique where
 newtype UniqueSet = US S.IntSet deriving (Eq, Ord, Show)
 
 instance IsSet UniqueSet where
-  type KeySet UniqueSet = Unique
+  type ElemOf UniqueSet = Unique
 
-  nullSet (US s) = S.null s
-  sizeSet (US s) = S.size s
-  memberSet (Unique k) (US s) = S.member k s
+  setNull (US s) = S.null s
+  setSize (US s) = S.size s
+  setMember (Unique k) (US s) = S.member k s
 
-  emptySet = US S.empty
-  singletonSet (Unique k) = US (S.singleton k)
-  insertSet (Unique k) (US s) = US (S.insert k s)
-  deleteSet (Unique k) (US s) = US (S.delete k s)
+  setEmpty = US S.empty
+  setSingleton (Unique k) = US (S.singleton k)
+  setInsert (Unique k) (US s) = US (S.insert k s)
+  setDelete (Unique k) (US s) = US (S.delete k s)
 
-  unionSet (US x) (US y) = US (S.union x y)
-  differenceSet (US x) (US y) = US (S.difference x y)
-  intersectionSet (US x) (US y) = US (S.intersection x y)
-  isSubsetOfSet (US x) (US y) = S.isSubsetOf x y
+  setUnion (US x) (US y) = US (S.union x y)
+  setDifference (US x) (US y) = US (S.difference x y)
+  setIntersection (US x) (US y) = US (S.intersection x y)
+  setIsSubsetOf (US x) (US y) = S.isSubsetOf x y
 
-  foldSet k z (US s) = S.fold (k . mkUnique) z s
+  setFold k z (US s) = S.fold (k . mkUnique) z s
 
-  elemsSet (US s) = map mkUnique (S.elems s)
-  fromListSet ks = US (S.fromList (map uniqueToInt ks))
+  setElems (US s) = map mkUnique (S.elems s)
+  setFromList ks = US (S.fromList (map uniqueToInt ks))
 
 -----------------------------------------------------------------------------
 -- UniqueMap
@@ -62,34 +62,34 @@ instance IsSet UniqueSet where
 newtype UniqueMap v = UM (M.IntMap v) deriving (Eq, Ord, Show)
 
 instance IsMap UniqueMap where
-  type KeyMap UniqueMap = Unique
+  type KeyOf UniqueMap = Unique
 
-  nullMap (UM m) = M.null m
-  sizeMap (UM m) = M.size m
-  memberMap (Unique k) (UM m) = M.member k m
-  lookupMap (Unique k) (UM m) = M.lookup k m
-  findWithDefaultMap def (Unique k) (UM m) = M.findWithDefault def k m
+  mapNull (UM m) = M.null m
+  mapSize (UM m) = M.size m
+  mapMember (Unique k) (UM m) = M.member k m
+  mapLookup (Unique k) (UM m) = M.lookup k m
+  mapFindWithDefault def (Unique k) (UM m) = M.findWithDefault def k m
 
-  emptyMap = UM M.empty
-  singletonMap (Unique k) v = UM (M.singleton k v)
-  insertMap (Unique k) v (UM m) = UM (M.insert k v m)
-  deleteMap (Unique k) (UM m) = UM (M.delete k m)
+  mapEmpty = UM M.empty
+  mapSingleton (Unique k) v = UM (M.singleton k v)
+  mapInsert (Unique k) v (UM m) = UM (M.insert k v m)
+  mapDelete (Unique k) (UM m) = UM (M.delete k m)
 
-  unionMap (UM x) (UM y) = UM (M.union x y)
-  unionWithKeyMap f (UM x) (UM y) = UM (M.unionWithKey (f . mkUnique) x y)
-  differenceMap (UM x) (UM y) = UM (M.difference x y)
-  intersectionMap (UM x) (UM y) = UM (M.intersection x y)
-  isSubmapOfMap (UM x) (UM y) = M.isSubmapOf x y
+  mapUnion (UM x) (UM y) = UM (M.union x y)
+  mapUnionWithKey f (UM x) (UM y) = UM (M.unionWithKey (f . mkUnique) x y)
+  mapDifference (UM x) (UM y) = UM (M.difference x y)
+  mapIntersection (UM x) (UM y) = UM (M.intersection x y)
+  mapIsSubmapOf (UM x) (UM y) = M.isSubmapOf x y
 
   mapMap f (UM m) = UM (M.map f m)
-  mapWithKeyMap f (UM m) = UM (M.mapWithKey (f . mkUnique) m)
-  foldMap k z (UM m) = M.fold k z m
-  foldWithKeyMap k z (UM m) = M.foldWithKey (k . mkUnique) z m
-
-  elemsMap (UM m) = M.elems m
-  keysMap (UM m) = map mkUnique (M.keys m)
-  toListMap (UM m) = [(mkUnique k, v) | (k, v) <- M.toList m]
-  fromListMap assocs = UM (M.fromList [(uniqueToInt k, v) | (k, v) <- assocs])
+  mapMapWithKey f (UM m) = UM (M.mapWithKey (f . mkUnique) m)
+  mapFold k z (UM m) = M.fold k z m
+  mapFoldWithKey k z (UM m) = M.foldWithKey (k . mkUnique) z m
+
+  mapElems (UM m) = M.elems m
+  mapKeys (UM m) = map mkUnique (M.keys m)
+  mapToList (UM m) = [(mkUnique k, v) | (k, v) <- M.toList m]
+  mapFromList assocs = UM (M.fromList [(uniqueToInt k, v) | (k, v) <- assocs])
 
 ----------------------------------------------------------------
 -- Monads
index 0cd5b4f..cc9d119 100644 (file)
@@ -107,7 +107,7 @@ instance LabelsPtr Label where
   targetLabels l = [l]
 
 instance LabelsPtr LabelSet where
-  targetLabels = elemsSet
+  targetLabels = setElems
 
 instance LabelsPtr l => LabelsPtr [l] where
   targetLabels = concatMap targetLabels
@@ -159,7 +159,7 @@ graphDfs :: (Edges (block n))
          -> (Graph' block n O x -> [block n C C])
 graphDfs _     (GNil)    = []
 graphDfs _     (GUnit{}) = []
-graphDfs order (GMany (JustO entry) (Body body) _) = order body entry emptySet
+graphDfs order (GMany (JustO entry) (Body body) _) = order body entry setEmpty
 
 postorder_dfs = graphDfs postorder_dfs_from_except
 preorder_dfs  = graphDfs preorder_dfs_from_except
@@ -171,11 +171,11 @@ postorder_dfs_from_except blocks b visited =
  where
    vnode :: block C C -> ([block C C] -> LabelSet -> a) -> [block C C] -> LabelSet -> a
    vnode block cont acc visited =
-        if memberSet id visited then
+        if setMember id visited then
             cont acc visited
         else
             let cont' acc visited = cont (block:acc) visited in
-            vchildren (get_children block) cont' acc (insertSet id visited)
+            vchildren (get_children block) cont' acc (setInsert id visited)
       where id = entryLabel block
    vchildren bs cont acc visited = next bs acc visited
       where next children acc visited =
@@ -188,7 +188,7 @@ postorder_dfs_from_except blocks b visited =
 
 postorder_dfs_from
     :: (Edges block, LabelsPtr b) => LabelMap (block C C) -> b -> [block C C]
-postorder_dfs_from blocks b = postorder_dfs_from_except blocks b emptySet
+postorder_dfs_from blocks b = postorder_dfs_from_except blocks b setEmpty
 
 
 ----------------------------------------------------------------
@@ -199,8 +199,8 @@ mark   :: Label -> VM ()
 instance Monad VM where
   return a = VM $ \visited -> (a, visited)
   m >>= k  = VM $ \visited -> let (a, v') = unVM m visited in unVM (k a) v'
-marked l = VM $ \v -> (memberSet l v, v)
-mark   l = VM $ \v -> ((), insertSet l v)
+marked l = VM $ \v -> (setMember l v, v)
+mark   l = VM $ \v -> ((), setInsert l v)
 
 preorder_dfs_from_except :: forall block e . (Edges block, LabelsPtr e)
                          => LabelMap (block C C) -> e -> LabelSet -> [block C C]
@@ -226,28 +226,28 @@ cons a as tail = a : as tail
 ----------------------------------------------------------------
 
 labelsDefined :: forall block n e x . Edges (block n) => Graph' block n e x -> LabelSet
-labelsDefined GNil      = emptySet
-labelsDefined (GUnit{}) = emptySet
+labelsDefined GNil      = setEmpty
+labelsDefined (GUnit{}) = setEmpty
 labelsDefined (GMany _ body x) = foldBodyBlocks addEntry body $ exitLabel x
-  where addEntry block labels = insertSet (entryLabel block) labels
+  where addEntry block labels = setInsert (entryLabel block) labels
         exitLabel :: MaybeO x (block n C O) -> LabelSet
-        exitLabel NothingO = emptySet
-        exitLabel (JustO b) = fromListSet [entryLabel b]
+        exitLabel NothingO = setEmpty
+        exitLabel (JustO b) = setFromList [entryLabel b]
 
 labelsUsed :: forall block n e x. Edges (block n) => Graph' block n e x -> LabelSet
-labelsUsed GNil      = emptySet
-labelsUsed (GUnit{}) = emptySet
+labelsUsed GNil      = setEmpty
+labelsUsed (GUnit{}) = setEmpty
 labelsUsed (GMany e body _) = foldBodyBlocks addTargets body $ entryTargets e
-  where addTargets block labels = insertListSet (successors block) labels
+  where addTargets block labels = setInsertList (successors block) labels
         entryTargets :: MaybeO e (block n O C) -> LabelSet
-        entryTargets NothingO = emptySet
-        entryTargets (JustO b) = addTargets b emptySet
+        entryTargets NothingO = setEmpty
+        entryTargets (JustO b) = addTargets b setEmpty
 
 foldBodyBlocks :: (block n C C -> a -> a) -> Body' block n -> a -> a
-foldBodyBlocks f (Body body) z = foldMap f z body
+foldBodyBlocks f (Body body) z = mapFold f z body
 
 externalEntryLabels :: Edges (block n) => Body' block n -> LabelSet
-externalEntryLabels body = defined `differenceSet` used
+externalEntryLabels body = defined `setDifference` used
   where defined = labelsDefined g
         used = labelsUsed g
         g = GMany NothingO body NothingO
index 9de9efc..6a76aeb 100644 (file)
@@ -185,7 +185,7 @@ foldGraphNodes f = graph
           graph (GUnit b)         = block b
           graph (GMany e b x)     = lift block e . body b . lift block x
           body :: Body n -> a -> a
-          body  (Body bdy)        = \a -> foldMap block a bdy
+          body  (Body bdy)        = \a -> mapFold block a bdy
           lift _ NothingO         = id
           lift f (JustO thing)    = f thing
 
@@ -201,7 +201,7 @@ lookupBlock :: Edges n => Graph n e x -> Label -> BlockResult n x
 lookupBlock (GMany _ _ (JustO exit)) lbl
   | entryLabel exit == lbl = ExitBlock exit
 lookupBlock (GMany _ (Body body)  _) lbl =
-  case lookupMap lbl body of
+  case mapLookup lbl body of
     Just b  -> BodyBlock b
     Nothing -> NoBlock
 lookupBlock GNil      _ = NoBlock