[add Name.Binary with fast binary instances for IdMap and IdSet, modify hoUsedIds to use that instead of a normal Set
John Meacham <john@repetae.net>**20061121014306] addfile ./Name/Binary.hs
hunk ./Ho/Type.hs 3
-import Binary
+import Data.Monoid
+import qualified Data.Map as Map
+import qualified Data.Set as Set
hunk ./Ho/Type.hs 8
+import Binary
hunk ./Ho/Type.hs 20
+import Name.Binary
hunk ./Ho/Type.hs 27
-import Data.Monoid
-import qualified Data.Map as Map
-import qualified Data.Set as Set
hunk ./Ho/Type.hs 41
+data Def = Def {
+    defTVr :: TVr,
+    defE :: E
+    }
+
+instance Binary Def where
+    put_ bh def = do
+        put_ bh (defTVr def)
+        lazyPut bh (defE def)
+    get bh = do
+        tvr <- get bh
+        e <- lazyGet bh
+        return Def { defTVr = tvr, defE = e }
+
hunk ./Ho/Type.hs 72
-    hoUsedIds :: Set.Set Id
+    hoUsedIds :: IdSet
hunk ./Main.hs 492
-        (cds,usedids) <- foldM dd ([],fromDistinctAscList $ Set.toList $ hoUsedIds ho) cds
+        (cds,usedids) <- foldM dd ([],hoUsedIds ho) cds
hunk ./Main.hs 571
-collectIds e = execWriter $ annotate mempty (\id nfo -> tell (Set.singleton id) >> return nfo) (\_ -> return) (\_ -> return) e
+collectIds e = execWriter $ annotate mempty (\id nfo -> tell (singleton id) >> return nfo) (\_ -> return) (\_ -> return) e
hunk ./Name/Binary.hs 1
+module Name.Binary() where
+
+import Maybe
+import Data.Monoid
+
+import Binary
+import Name.Id
+import Name.Name
+
+
+instance Binary IdSet where
+    put_ bh ids = do
+        putNList bh [ id | id <- idSetToList ids, isNothing (fromId id)]
+        putNList bh [ n | id <- idSetToList ids, n <- fromId id]
+    get bh = do
+        (idl:: [Id])   <- getNList bh
+        (ndl:: [Name]) <- getNList bh
+        return (idSetFromDistinctAscList idl `mappend` idSetFromList (map toId ndl))
+
+
+instance Binary a => Binary (IdMap a) where
+    put_ bh ids = do
+        putNList bh [ x | x@(id,_) <- idMapToList ids, isNothing (fromId id)]
+        putNList bh [ (n,v) | (id,v) <- idMapToList ids, n <- fromId id]
+    get bh = do
+        idl <- getNList bh
+        ndl <- getNList bh
+        return (idMapFromDistinctAscList idl `mappend` idMapFromList ndl)
+
hunk ./Name/Id.hs 13
+    idSetFromList,
+    idSetFromDistinctAscList,
+    idMapFromList,
+    idMapFromDistinctAscList,
hunk ./Name/Id.hs 18
+    idMapToList,
hunk ./Name/Id.hs 50
+idMapToList :: IdMap a -> [(Id,a)]
+idMapToList (IdMap is) = IM.toList is
+
hunk ./Name/Id.hs 132
+idSetFromDistinctAscList :: [Id] -> IdSet
+idSetFromDistinctAscList ids = IdSet (IS.fromDistinctAscList ids)
+
+idSetFromList :: [Id] -> IdSet
+idSetFromList ids = IdSet (IS.fromList ids)
+
+idMapFromList :: [(Id,a)] -> IdMap a
+idMapFromList ids = IdMap (IM.fromList ids)
+
+idMapFromDistinctAscList :: [(Id,a)] -> IdMap a
+idMapFromDistinctAscList ids = IdMap (IM.fromDistinctAscList ids)
+
hunk ./Name/Name.hs 170
-fromId i = case intToAtom i of
-    Just a -> return $ Name a
-    Nothing -> fail $ "Name.fromId: not a name " ++ show i
+fromId i | even i || i < 0 = fail $ "Name.fromId: not a name " ++ show i
+fromId i = return $ case intToAtom i of
+    Just a -> Name a
+    Nothing -> error $ "Name.fromId: not a name " ++ show i