[make the binary format smaller, use a hash of the type for serializing 'Info' nodes, only use a single byte for atom lengths, use a word32 for storing Id numbers
John Meacham <john@repetae.net>**20080210102626] hunk ./Atom.hs 21
+import Data.Binary.Get
+import Data.Binary.Put
hunk ./Atom.hs 64
-    get = (toAtom :: BS.ByteString -> Atom) `fmap` get
-    put a = put (fromAtom a :: BS.ByteString)
+    get = do
+        x <- getWord8
+        bs <- getBytes (fromIntegral x)
+        return $ toAtom bs
+    put a = do
+        let bs = fromAtom a
+        putWord8 $ fromIntegral $ BS.length bs
+        putByteString bs
hunk ./E/Binary.hs 12
-data TvrBinary = TvrBinaryNone | TvrBinaryAtom Atom | TvrBinaryInt Int
+data TvrBinary = TvrBinaryNone | TvrBinaryAtom Atom | TvrBinaryInt Word32
hunk ./E/Binary.hs 24
-        put (TvrBinaryInt i)
+        put (TvrBinaryInt $ fromIntegral i)
hunk ./E/Binary.hs 34
-            TvrBinaryInt i -> return $ TVr (i) e nf
+            TvrBinaryInt i -> return $ TVr (fromIntegral i) e nf
hunk ./Info/Binary.hs 5
+import Data.Word
hunk ./Info/Binary.hs 7
-import Atom
+import StringTable.Atom(HasHash(..))
hunk ./Info/Binary.hs 24
-createTyp :: Typeable a => a -> Atom
-createTyp x = toAtom (show (typeOf x))
+createTyp :: Typeable a => a -> Word32
+createTyp x = hash32 $ (show (typeOf x))
hunk ./Info/Binary.hs 30
+binTable :: Map.Map Word32 Binable
hunk ./Info/Binary.hs 39
-putDyn :: (Atom,Dynamic,Binable) -> Put
+putDyn :: (Word32,Dynamic,Binable) -> Put
hunk ./Info/Binary.hs 50
-    (ps::Atom) <- get
+    (ps::Word32) <- get
hunk ./Info/Binary.hs 70
-            let ps = toAtom (show $ entryType d)
+            let ps = hash32 $ (show $ entryType d)
hunk ./Info/Info.hs 7
+    Info.Info.lookupTyp,
hunk ./Info/Info.hs 28
-import Atom
hunk ./Info/Info.hs 83
-    g [] = fail "Info: could not find " ++ show typ
+    g [] = Nothing
+    g (x:xs) | entryType x == typ = fromDynamic (entryThing x)
+    g (_:xs) = g xs
hunk ./Info/Info.hs 87
-lookup :: forall a m .  (Monad m,Typeable a) => Info -> m a
-lookup (Info mp) = do
-    let typ = typeOf (undefined :: a)
-        f [] = fail $ "Info: could not find " ++ show typ
-        f (x:xs) | entryType x == typ = case fromDynamic (entryThing x) of
-            Just x -> return x
-            Nothing -> error "Info.lookup: this can't happen"
-        f (_:xs) = f xs
-    f mp
+
+lookup :: forall a m . (Monad m,Typeable a) => Info -> m a
+lookup = maybe (fail $ "Info: could not find: " ++ show typ) return . f where
+    typ = typeOf (undefined :: a)
+    f = lookupTyp (undefined :: a)
hunk ./Info/Info.hs 94
-createTyp :: Typeable a => a -> Atom
-createTyp (_::a) = toAtom (show (typeOf (undefined :: a)))
hunk ./Info/Types.hs 52
+fetchProperties :: Info.Info -> Maybe Properties
+fetchProperties = Info.lookupTyp (undefined :: Properties)
hunk ./Info/Types.hs 56
-    modifyProperties f info = case Info.lookup info of
+    modifyProperties f info = case fetchProperties info of
hunk ./Info/Types.hs 59
-    getProperties info = case Info.lookup info of
+    getProperties info = case fetchProperties info of
hunk ./StringTable/Atom.hsc 6
+    HasHash(..),
hunk ./StringTable/Atom.hsc 23
+import Foreign.Marshal
hunk ./StringTable/Atom.hsc 50
+class HasHash a where
+    hash32 :: a -> Word32
+
+instance HasHash Atom where
+    hash32 a = let (x,y) = fromAtom a :: CStringLen in unsafePerformIO $ hash2 0 x (fromIntegral y)
+
+instance HasHash BS.ByteString where
+    hash32 bs = unsafePerformIO $ do
+        BS.unsafeUseAsCStringLen bs $ \ (x,y) -> hash2 0 x (fromIntegral y)
+
+instance HasHash String where
+    hash32 s = unsafePerformIO $ withCStringLen s $ \ (x,y) -> hash2 0 x (fromIntegral y)
+
+
+
hunk ./StringTable/Atom.hsc 136
+foreign import ccall unsafe hash2  :: Word32 -> CString -> CInt -> IO Word32
hunk ./StringTable/StringTable_cbits.c 23
-static uint32_t hash2(uint32_t salt,unsigned char *key, int key_len);
+uint32_t hash2(uint32_t salt,unsigned char *key, int key_len);
hunk ./StringTable/StringTable_cbits.c 381
-static uint32_t
+uint32_t
hunk ./utils/gsource 2
-find . ! -wholename '*/test/*' ! -wholename '*/lib/*' ! -wholename '*/_darcs/*' ! -wholename '*/drift_processed/*'  ! -wholename '*/regress/*'  \( -name '*.hs' -o -name '*.hsc' \)
+
+find . ! -wholename '*/test/*' ! -wholename '*/lib/*' ! -wholename '*/_darcs/*' ! -wholename '*/drift_processed/*'  ! -wholename '*/regress/*'  \( -name '*.hs' -o -name '*.hsc' \) | xargs grep "$@" --