[get rid of a bunch of warnings, migrate some code to use GMap
John Meacham <john@repetae.net>**20100727080414
 Ignore-this: 39fc733d780c49d95c5015acc64c8c52
] hunk ./src/C/FromGrin2.hs 37
+import Util.SetLike
+import Util.GMap
hunk ./src/C/FromGrin2.hs 85
-    ityrep = Map.mapMaybeWithKey tyRep tmap
+    ityrep = Map.mapMaybeWithKey tyRep (fromDistinctAscList $ Util.SetLike.toList tmap)
hunk ./src/C/FromGrin2.hs 105
-        triv x = case Map.lookup x tmap of
+        triv x = case mlookup x tmap of
hunk ./src/C/FromGrin2.hs 165
-                    convertFunc (Map.lookup a (grinEntryPoints grin)) (a,l)
+                    convertFunc (mlookup a (grinEntryPoints grin)) (a,l)
hunk ./src/C/FromGrin2.hs 541
-        case Map.lookup t cpr of
+        case mlookup t cpr of
hunk ./src/C/FromGrin2.hs 584
-    case a `Map.lookup` lm of
+    case a `mlookup` lm of
hunk ./src/C/FromGrin2.hs 628
-        ntag = case Map.lookup a cpr of
+        ntag = case mlookup a cpr of
hunk ./src/C/FromGrin2.hs 759
-    case Map.lookup t cpr of
+    case mlookup t cpr of
hunk ./src/C/FromGrin2.hs 827
-                       | Just TyRepUntagged <- Map.lookup n cpr = ([],False)
+                       | Just TyRepUntagged <- mlookup n cpr = ([],False)
hunk ./src/C/FromGrin2.hs 847
-    case Map.lookup a cpr of
+    case mlookup a cpr of
hunk ./src/E/Traverse.hs 16
-import Data.Monoid
hunk ./src/FrontEnd/Class.hs 24
-import Data.Monoid
hunk ./src/FrontEnd/Class.hs 26
+import Debug.Trace
hunk ./src/FrontEnd/Class.hs 30
-import Debug.Trace
hunk ./src/FrontEnd/Class.hs 42
-import Monad
hunk ./src/FrontEnd/Desugar.hs 12
-import FrontEnd.SrcLoc
hunk ./src/FrontEnd/Syn/Traverse.hs 3
-import qualified Data.Set as Set
hunk ./src/FrontEnd/Syn/Traverse.hs 4
+import qualified Data.Set as Set
hunk ./src/FrontEnd/Syn/Traverse.hs 7
-import Control.Monad.Identity
hunk ./src/FrontEnd/Syn/Traverse.hs 8
-import Support.FreeVars
hunk ./src/FrontEnd/Syn/Traverse.hs 9
+import Support.FreeVars
hunk ./src/FrontEnd/Tc/Class.hs 27
-import FrontEnd.Tc.Kind
hunk ./src/FrontEnd/Tc/Unify.hs 9
-import Control.Monad.Reader
hunk ./src/FrontEnd/Tc/Unify.hs 21
-import Name.Names
hunk ./src/FrontEnd/Tc/Unify.hs 110
-tArrow_star :: Type
-tArrow_star = TCon (Tycon tc_Arrow (kindStar `Kfun` (kindStar `Kfun` kindStar)))
-
hunk ./src/Grin/DeadCode.hs 15
-import Stats hiding(print)
+import Stats hiding(print, singleton)
hunk ./src/Grin/DeadCode.hs 18
+import Util.SetLike hiding(Value)
hunk ./src/Grin/DeadCode.hs 46
-        addRule $ conditionalRule id v' $ (suspFuncs `isSuperSetOf` value (Set.singleton fn))
+        addRule $ conditionalRule id v' $ (suspFuncs `isSuperSetOf` value (singleton fn))
hunk ./src/Grin/DeadCode.hs 70
-                 `Set.union`
-                 Set.fromList [ (n,i) | FuncDef n (args :-> _) _ _ <- grinFunctions grin,
-                                        n `Map.member` grinEntryPoints grin,
+                 `union`
+                 fromList [ (n,i) | FuncDef n (args :-> _) _ _ <- grinFunctions grin,
+                                        n `member` grinEntryPoints grin,
hunk ./src/Grin/DeadCode.hs 74
-        directFuncs =  funSet Set.\\ suspFuncs Set.\\ pappFuncs
-        fg xs = Set.fromList [ x | (x,True) <- xs ]
-    newCafs <- flip mconcatMapM (grinCafs grin) $ \ (x,y) -> if x `Set.member` cafSet then return [(x,y)] else tick stats "Optimize.dead-code.caf" >> return []
+        directFuncs =  funSet \\ suspFuncs \\ pappFuncs
+        fg xs = fromList [ x | (x,True) <- xs ]
+    newCafs <- flip mconcatMapM (grinCafs grin) $ \ (x,y) -> if x `member` cafSet then return [(x,y)] else tick stats "Optimize.dead-code.caf" >> return []
hunk ./src/Grin/DeadCode.hs 78
-            if not $ x `Set.member` funSet then tick stats "Optimize.dead-code.func" >> f xs rs ws else do
+            if not $ x `member` funSet then tick stats "Optimize.dead-code.func" >> f xs rs ws else do
hunk ./src/Grin/DeadCode.hs 85
-    mp' <- flip mconcatMapM (Map.toList mp) $ \ (x,tyty@TyTy { tySlots = ts }) -> case Just x  of
-        Just _ | tagIsFunction x, not $ x `Set.member` funSet -> return []
-        Just fn | fn `Set.member` directFuncs -> do
+    mp' <- flip mconcatMapM (toList mp) $ \ (x,tyty@TyTy { tySlots = ts }) -> case Just x  of
+        Just _ | tagIsFunction x, not $ x `member` funSet -> return []
+        Just fn | fn `member` directFuncs -> do
hunk ./src/Grin/DeadCode.hs 89
-                    | Set.member (fn,i) argSet = return [t]
+                    | member (fn,i) argSet = return [t]
hunk ./src/Grin/DeadCode.hs 98
-        grinTypeEnv = TyEnv $ Map.fromList mp',
+        grinTypeEnv = TyEnv $ fromList mp',
hunk ./src/Grin/DeadCode.hs 156
-                suspfn | x > 0 = conditionalRule id fn' (pappFuncs `isSuperSetOf` value (Set.singleton fn))
-                       | otherwise = conditionalRule id fn' (suspFuncs `isSuperSetOf` value (Set.singleton fn))
+                suspfn | x > 0 = conditionalRule id fn' (pappFuncs `isSuperSetOf` value (singleton fn))
+                       | otherwise = conditionalRule id fn' (suspFuncs `isSuperSetOf` value (singleton fn))
hunk ./src/Grin/DeadCode.hs 203
-    dff' fn as | fn `Set.member` directFuncs = return as
+    dff' fn as | fn `member` directFuncs = return as
hunk ./src/Grin/DeadCode.hs 205
-    dff fn as | fn `Set.member` directFuncs = return (removeArgs fn as)
+    dff fn as | fn `member` directFuncs = return (removeArgs fn as)
hunk ./src/Grin/DeadCode.hs 207
-    dff'' fn as | not (fn `Set.member` funSet) = return as -- if function was dropped, we don't have argument use information.
+    dff'' fn as | not (fn `member` funSet) = return as -- if function was dropped, we don't have argument use information.
hunk ./src/Grin/DeadCode.hs 209
-        df (a,i) | not (deadVal a) && not (Set.member (fn,i) usedArgs) = do
+        df (a,i) | not (deadVal a) && not (member (fn,i) usedArgs) = do
hunk ./src/Grin/DeadCode.hs 222
-    deadCaf v = v < v0 && not (v `Set.member` usedCafs)
+    deadCaf v = v < v0 && not (v `member` usedCafs)
hunk ./src/Grin/DeadCode.hs 225
-    removeArgs fn as = concat [ perhapsM ((fn,i) `Set.member` usedArgs) a | a <- as | i <- naturals ]
+    removeArgs fn as = concat [ perhapsM ((fn,i) `member` usedArgs) a | a <- as | i <- naturals ]
hunk ./src/Grin/EvalInline.hs 5
-import List
+import List hiding(union)
hunk ./src/Grin/EvalInline.hs 10
+import Util.SetLike
hunk ./src/Grin/EvalInline.hs 164
-        appTyEnv = Map.fromList ntyenv
-    return $ setGrinFunctions (apps ++ funcs) grin { grinTypeEnv = TyEnv (tyEnv `Map.union` appTyEnv) }
+        appTyEnv = fromList ntyenv
+    return $ setGrinFunctions (apps ++ funcs) grin { grinTypeEnv = TyEnv (tyEnv `union` appTyEnv) }
hunk ./src/Grin/FromE.hs 3
-import Char
hunk ./src/Grin/FromE.hs 4
-import Control.Monad.Trans
hunk ./src/Grin/FromE.hs 21
-import E.FreeVars
hunk ./src/Grin/FromE.hs 33
-import Name.VConsts
hunk ./src/Grin/FromE.hs 37
-import Support.Tuple
hunk ./src/Grin/FromE.hs 39
-import Util.SetLike
+import Util.SetLike as SL
+import Util.GMap
hunk ./src/Grin/FromE.hs 42
-import qualified C.FFI as FFI
hunk ./src/Grin/FromE.hs 96
-dumpTyEnv (TyEnv tt) = mapM_ putStrLn $ sort [ fromAtom n <+> hsep (map show as) <+> "::" <+> show t <> f z <> g th|  (n,TyTy { tySlots = as, tyReturn = t, tySiblings = z, tyThunk = th}) <- Map.toList tt] where
+dumpTyEnv (TyEnv tt) = mapM_ putStrLn $ sort [ fromAtom n <+> hsep (map show as) <+> "::" <+> show t <> f z <> g th|  (n,TyTy { tySlots = as, tyReturn = t, tySiblings = z, tyThunk = th}) <- toList tt] where
hunk ./src/Grin/FromE.hs 211
-    let newTyEnv = TyEnv $ Map.fromList (Map.toList endTyEnv ++ [(funcMain, toTyTy ([],[]))] ++ [(en, toTyTy ([],[])) | en <- enames])
+    let newTyEnv = TyEnv $ fromList (toList endTyEnv ++ [(funcMain, toTyTy ([],[]))] ++ [(en, toTyTy ([],[])) | en <- enames])
hunk ./src/Grin/FromE.hs 223
-            grinEntryPoints = Map.insert funcMain (FfiExport "_amain" Safe CCall [] "void") $
-                                Map.fromList epv,
+            grinEntryPoints = minsert funcMain (FfiExport "_amain" Safe CCall [] "void") $
+                                fromList epv,
hunk ./src/Grin/FromE.hs 233
-    initTyEnv = mappend primTyEnv $ TyEnv $ Map.fromList $ concat [ makePartials (a,b,c) | (_,(a,b,c)) <-  toList scMap] ++ concat [con x| x <- [cabsurd] ++ Map.elems (constructorMap dataTable), conType x /= eHash]
+    initTyEnv = mappend primTyEnv $ TyEnv $ fromList $ concat [ makePartials (a,b,c) | (_,(a,b,c)) <-  toList scMap] ++ concat [con x| x <- [cabsurd] ++ values (constructorMap dataTable), conType x /= eHash]
hunk ./src/Grin/FromE.hs 272
-primTyEnv = TyEnv . Map.map toTyTy $ Map.fromList $ [
+primTyEnv = TyEnv . fmap toTyTy $ fromList $ [
hunk ./src/Grin/FromE.hs 586
-        let addt (TyEnv mp) =  TyEnv $ Map.insert sfn sft (Map.insert n (toTyTy (args',getType body)) mp)
+        let addt (TyEnv mp) =  TyEnv $ minsert sfn sft (minsert n (toTyTy (args',getType body)) mp)
hunk ./src/Grin/Grin.hs 64
-import StringTable.Atom
hunk ./src/Grin/Grin.hs 66
+import Cmm.Number
hunk ./src/Grin/Grin.hs 68
-import GenUtil
hunk ./src/Grin/Grin.hs 69
-import Cmm.Number
hunk ./src/Grin/Grin.hs 70
+import StringTable.Atom
hunk ./src/Grin/Grin.hs 74
-import qualified Info.Info as Info
+import Util.SetLike
+import Util.GMap
+import Util.HasSize
+import Util.Gen
hunk ./src/Grin/Grin.hs 79
+import qualified Info.Info as Info
hunk ./src/Grin/Grin.hs 103
-newtype TyEnv = TyEnv (Map.Map Atom TyTy)
+newtype TyEnv = TyEnv (GMap Atom TyTy)
hunk ./src/Grin/Grin.hs 268
-extendTyEnv ds (TyEnv env) = TyEnv (Map.fromList xs `mappend` env) where
+extendTyEnv ds (TyEnv env) = TyEnv (fromList xs `mappend` env) where
hunk ./src/Grin/Grin.hs 350
-    grinEntryPoints :: Map.Map Atom FfiExport,
+    grinEntryPoints :: GMap Atom FfiExport,
hunk ./src/Grin/Grin.hs 372
-grinEntryPointNames = Map.keys . grinEntryPoints
+grinEntryPointNames = keys . grinEntryPoints
hunk ./src/Grin/Grin.hs 487
-findTyTy (TyEnv m) a | Just tyty <-  Map.lookup a m = return tyty
-findTyTy (TyEnv m) a | ('Y':rs) <- fromAtom a, (ns,'_':rs) <- span isDigit rs  = case Map.lookup (toAtom ('T':rs)) m of
+findTyTy (TyEnv m) a | Just tyty <-  mlookup a m = return tyty
+findTyTy (TyEnv m) a | ('Y':rs) <- fromAtom a, (ns,'_':rs) <- span isDigit rs  = case mlookup (toAtom ('T':rs)) m of
hunk ./src/Grin/Grin.hs 625
-instance FreeVars Exp [Var] where
-    freeVars e = Set.toList $ freeVars e
-instance FreeVars Val [Var] where
-    freeVars e = Set.toList $ freeVars e
-instance FreeVars Lam [Var] where
-    freeVars e = Set.toList $ freeVars e
hunk ./src/Grin/Grin.hs 660
+instance FreeVars Lam (GSet Var) where
+    freeVars (x :-> y) = freeVars y \\ freeVars x
+
+instance  FreeVars Exp (GSet Var,GSet Tag) where
+    freeVars x = (freeVars x, freeVars x)
+
+instance FreeVars Val (GSet Var) where
+    freeVars (NodeC t xs) = freeVars xs
+    freeVars (Const v) = freeVars v
+    freeVars (Index a b) = freeVars (a,b)
+    freeVars (Var v _) = singleton v
+    freeVars _ = sempty
+
+
+instance FreeVars FuncProps (GSet Var) where
+    freeVars FuncProps { funcFreeVars = fv } = fromDistinctAscList $ toList fv
+
+instance FreeVars FuncProps (GSet Tag) where
+    freeVars FuncProps { funcTags = fv } = fromDistinctAscList $ toList fv
+
+instance FreeVars Exp (GSet Var) where
+    freeVars (a :>>= b) = freeVars (a,b)
+    freeVars (App a vs _) =  freeVars vs
+    freeVars (Case x xs) = freeVars (x,xs)
+    freeVars (Return v) = freeVars v
+--    freeVars (Store v) = freeVars v
+    freeVars (BaseOp _ vs) = freeVars vs
+    freeVars (Prim _ x _) = freeVars x
+    freeVars Error {} = sempty
+    freeVars Let { expDefs = fdefs, expBody = body } = mconcat (map (fromDistinctAscList . toList . funcFreeVars . funcDefProps) fdefs) `mappend` freeVars body
+    freeVars NewRegion { expLam = l } = freeVars l
+    freeVars Alloc { expValue = v, expCount = c, expRegion = r } = freeVars (v,c,r)
+    freeVars Call { expValue = v, expArgs = as } = freeVars (v:as)
+    freeVars MkClosure { expValue = v, expArgs = as, expRegion = r } = freeVars (v,as,r)
+    freeVars MkCont { expCont = v, expLam = as} = freeVars (v,as)
+    freeVars GcRoots { expValues = v, expBody = b } = freeVars (v,b)
+
+instance FreeVars Exp [Var] where
+    freeVars e = toList $ (freeVars e :: GSet Var)
+instance FreeVars Val [Var] where
+    freeVars e = toList $ (freeVars e :: GSet Var)
+instance FreeVars Lam [Var] where
+    freeVars e = toList $ (freeVars e :: GSet Var)
+
+
+instance FreeVars Val (GSet Tag) where
+    freeVars (NodeC t xs) = singleton t `union` freeVars xs
+    freeVars (Index a b) = freeVars (a,b)
+    freeVars (Const v) = freeVars v
+    freeVars _ = sempty
+
+instance FreeVars Lam (GSet Tag) where
+    freeVars (a :-> b) = freeVars (a,b)
+
+
+instance FreeVars Exp (GSet Tag) where
+    freeVars (a :>>= b) = freeVars (a,b)
+    freeVars (App a vs _) = singleton a `union` freeVars vs
+    freeVars (Case x xs) = freeVars (x,xs)
+    freeVars (Return v) = freeVars v
+--    freeVars (Store v) = freeVars v
+    freeVars (BaseOp _ vs) = freeVars vs
+    freeVars (Prim _ x _) = freeVars x
+    freeVars Error {} = sempty
+    freeVars Let { expDefs = fdefs, expBody = body } = unions (map (fromDistinctAscList . toList . funcTags . funcDefProps) fdefs) `mappend` freeVars body
+    freeVars NewRegion { expLam = l } = freeVars l
+    freeVars Alloc { expValue = v, expCount = c, expRegion = r } = freeVars (v,c,r)
+    freeVars Call { expValue = v, expArgs = as } = freeVars (v:as)
+    freeVars MkClosure { expValue = v, expArgs = as, expRegion = r } = freeVars (v,as,r)
+    freeVars MkCont { expCont = v, expLam = as} = freeVars (v,as)
+    freeVars GcRoots { expValues = v, expBody = b } = freeVars (v,b)
hunk ./src/Grin/Grin.hs 739
+instance Intjection Var where
+    toIntjection i = V (fromIntegral i)
+    fromIntjection (V i) = fromIntegral i
hunk ./src/Grin/Grin.hs 744
+newtype instance GSet Var = GSetVar (IntjectionSet Var)
+    deriving(Monoid,IsEmpty,HasSize,Collection,Unionize,SetLike,Eq,Ord)
+newtype instance GMap Var v = GMapVar (IntjectionMap Var v)
+    deriving(Monoid,IsEmpty,HasSize,Collection,Unionize,SetLike,MapLike,Eq,Ord)
hunk ./src/Grin/Noodle.hs 8
-import Data.Functor
-import Support.FreeVars
-import StringTable.Atom(Atom())
-import Options(flint)
hunk ./src/Grin/Noodle.hs 9
-import Util.Gen
+import Data.Functor
+import Debug.Trace
hunk ./src/Grin/Noodle.hs 12
+import Options(flint)
+import StringTable.Atom(Atom())
hunk ./src/Grin/Noodle.hs 15
-import Debug.Trace
+import Support.FreeVars
hunk ./src/Grin/Noodle.hs 17
+import Util.GMap
+import Util.Gen
+import Util.SetLike
+import Util.HasSize
hunk ./src/Grin/Noodle.hs 24
-modifyTail lam@(_ :-> lb) te = f mempty te where
-    lamFV = freeVars lam :: Set.Set Var
+modifyTail lam@(_ :-> lb) te = f (sempty :: GSet Atom) te where
+    lamFV = freeVars lam :: GSet Var
hunk ./src/Grin/Noodle.hs 31
-        nlf = lf `Set.union` Set.fromList (map funcDefName defs)
+        nlf = lf `union` fromList (map funcDefName defs)
hunk ./src/Grin/Noodle.hs 35
-    f lf e@(App a as t) | a `Set.member` lf = App a as (getType lb)
+    f lf e@(App a as t) | a `member` lf = App a as (getType lb)
hunk ./src/Grin/Noodle.hs 37
-    g lf (p :-> e) | flint && not (Set.null $ Set.intersection (freeVars p) lamFV) = error "modifyTail: lam floated inside bad scope"
+    g lf (p :-> e) | flint && not (isEmpty $ intersection (freeVars p) lamFV) = error "modifyTail: lam floated inside bad scope"
hunk ./src/Grin/Noodle.hs 136
-isManifestNode e = f mempty e where
+isManifestNode e = f (sempty :: GSet Atom) e where
hunk ./src/Grin/Noodle.hs 140
-    f lf (App a _ _) | a `Set.member` lf = return []
+    f lf (App a _ _) | a `member` lf = return []
hunk ./src/Grin/Noodle.hs 143
-        nlf = lf `Set.union` Set.fromList (map funcDefName defs)
+        nlf = lf `union` fromList (map funcDefName defs)
hunk ./src/Grin/Noodle.hs 199
-        cfunc (App a _ _) = return (Set.singleton a)
+        cfunc (App a _ _) = return (singleton a)
hunk ./src/Grin/Noodle.hs 230
-            expFuncCalls = (tail Set.\\ myDefs, nonTail Set.\\ myDefs),
+            expFuncCalls = (tail \\ myDefs, nonTail \\ myDefs),
hunk ./src/Grin/Noodle.hs 232
-            expIsNormal = Set.null notNormal
+            expIsNormal = isEmpty notNormal
hunk ./src/Grin/Noodle.hs 235
-    notNormal =  nonTail `Set.intersection` (Set.fromList $ map funcDefName defs)
-    myDefs = Set.fromList $ map funcDefName defs
+    notNormal =  nonTail `intersection` (fromList $ map funcDefName defs)
+    myDefs = fromList $ map funcDefName defs
hunk ./src/Grin/Noodle.hs 245
-    ans = execWriter (f mempty e)
+    ans = execWriter (f (sempty :: GSet Atom) e)
hunk ./src/Grin/Noodle.hs 253
-    f lf (App a _ _) | a `Set.member` lf = return ()
+    f lf (App a _ _) | a `member` lf = return ()
hunk ./src/Grin/Noodle.hs 255
-        nlf = lf `Set.union` Set.fromList (map funcDefName defs)
+        nlf = lf `union` fromList (map funcDefName defs)
hunk ./src/StringTable/Atom.hsc 19
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.UTF8 as BS(fromString,toString)
-import qualified Data.ByteString.Internal as BS
-import qualified Data.ByteString.Unsafe as BS
-import Control.Monad
hunk ./src/StringTable/Atom.hsc 22
-import Foreign
-import Foreign.Marshal
-import Data.Word
-import Data.Char
-import Foreign.C
-import Data.Monoid
-import Data.Dynamic
hunk ./src/StringTable/Atom.hsc 24
+import Data.Monoid
+import Foreign
+import Foreign.C
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Internal as BS
+import qualified Data.ByteString.UTF8 as BS(fromString,toString)
+import qualified Data.ByteString.Unsafe as BS
+
+import Util.GMap
+import Util.SetLike
+import Util.HasSize
hunk ./src/StringTable/Atom.hsc 152
+instance Intjection Atom where
+    toIntjection i = Atom (fromIntegral i)
+    fromIntjection (Atom i) = fromIntegral i
+
+
+newtype instance GSet Atom = GSetAtom (IntjectionSet Atom)
+    deriving(Monoid,IsEmpty,HasSize,Collection,Unionize,SetLike,Eq,Ord,Show)
+newtype instance GMap Atom v = GMapAtom (IntjectionMap Atom v)
+    deriving(Monoid,IsEmpty,HasSize,Collection,Unionize,SetLike,MapLike,Eq,Ord)
+
+instance Functor (GMap Atom) where
+    fmap f (GMapAtom (IntjectionMap mp)) = GMapAtom (IntjectionMap (fmap f mp))
hunk ./src/Util/GMap.hs 7
+import qualified Data.Set as Set
hunk ./src/Util/GMap.hs 35
-data instance GSet [a] = GDone | GCons (GMap a (GSet [a]))
+--newtype instance GSet (a,b) = GSetTup2 (GMap a (GSet b))
hunk ./src/Util/GMap.hs 37
+gsetToSet :: (Collection (GSet a), Ord a) => GSet a -> Set.Set a
+gsetToSet gs = Set.fromDistinctAscList (toList gs)
hunk ./src/Util/SetLike.hs 222
+instance (Intjection a,Show a) => Show (IntjectionSet a) where
+    showsPrec n is = showsPrec n $ toList is
+