Changeset 11716 for third-party

Show
Ignore:
Timestamp:
07/24/06 00:34:43 (2 years ago)
Author:
cmarcelo
Message:

* Fixes GC.freeRef being called for non-GC Refeable types. Still could
be better.

Location:
third-party/HsJudy
Files:
6 modified

Legend:

Unmodified
Added
Removed

  • third-party/HsJudy/Judy/Map.hs

    r11676 r11716  
    117117rawElems = internalMap $ \r _ _ -> peek r 
    118118 
    119 new_ :: IO (Map k a) 
     119dummy :: Refeable a => Map k a -> a 
     120dummy = undefined 
     121 
     122 
     123new_ :: Refeable a => IO (Map k a) 
    120124new_ = do 
    121125    fp <- mallocForeignPtr 
    122     finalize' <- mkFin $ finalize (needGC (undefined :: a)) 
     126    withForeignPtr fp $ flip poke nullPtr 
     127    m <- return $ Map fp 
     128 
     129    finalize' <- mkFin $ finalize $ needGC (dummy m) 
    123130    addForeignPtrFinalizer finalize' fp  
    124     withForeignPtr fp $ flip poke nullPtr 
    125     return $ Map fp 
     131    return m 
    126132 
    127133insert_ :: (Stringable k, Refeable a) => k -> a -> Map k a -> IO () 
    … …  
    154160                            return Nothing 
    155161                    else if v /= (fromJust fv) 
    156                              then do when (needGC (undefined :: a)) $ GC.freeRef v' 
     162                             then do when (needGC (fromJust fv)) $ GC.freeRef v' 
    157163                                     x <- toRef (fromJust fv) 
    158164                                     poke r x 
    … …  
    180186 
    181187delete_ :: Stringable k => k -> Map k a -> IO Bool 
    182 delete_ k (Map j) = withForeignPtr j $ \j' -> do 
     188delete_ k m@(Map j) = withForeignPtr j $ \j' -> do 
    183189    j'' <- peek j' 
    184190    useAsCSLen k $ \(cp, len) -> do 
    185         when (needGC (undefined :: a)) $ do 
     191        when (needGC (dummy m)) $ do 
    186192            r <- judyHSGet j'' cp (fromIntegral len) 
    187193            if r == nullPtr 

  • third-party/HsJudy/Judy/Map2.hs

    r11676 r11716  
    7474rawElems = internalMap $ \r _ -> peek r 
    7575 
    76 new_ :: IO (Map2 k a) 
     76dummy :: Refeable a => Map2 k a -> a 
     77dummy = undefined 
     78 
     79new_ :: Refeable a => IO (Map2 k a) 
    7780new_ = do 
    7881    fp <- mallocForeignPtr 
    79     finalize' <- mkFin $ finalize (needGC (undefined :: a)) 
     82    withForeignPtr fp $ flip poke nullPtr 
     83    m <- return $ Map2 fp 
     84 
     85    finalize' <- mkFin $ finalize $ needGC (dummy m) 
    8086    addForeignPtrFinalizer finalize' fp  
    81     withForeignPtr fp $ flip poke nullPtr 
    82     return $ Map2 fp 
     87    return m 
    8388 
    8489insert_ :: (ReversibleHashIO k, Refeable a) => k -> a -> Map2 k a -> IO () 
    … …  
    107112                        return Nothing           -- FIXME check delete output 
    108113                else if v /= (fromJust fv) 
    109                          then do when (needGC (undefined :: a)) $ GC.freeRef v' 
     114                         then do when (needGC (fromJust fv)) $ GC.freeRef v' 
    110115                                 x <- toRef (fromJust fv) 
    111116                                 poke r x 
    … …  
    130135 
    131136delete_ :: ReversibleHashIO k => k -> Map2 k a -> IO Bool 
    132 delete_ k (Map2 j) = withForeignPtr j $ \j' -> do 
     137delete_ k m@(Map2 j) = withForeignPtr j $ \j' -> do 
    133138    j'' <- peek j' 
    134139    k' <- hashIO k 
    135     when (needGC (undefined :: a)) $ do 
     140    when (needGC (dummy m)) $ do 
    136141        r <- judyLGet j'' k' judyError 
    137142        if r == nullPtr 

  • third-party/HsJudy/Judy/MapSL.hs

    r11676 r11716  
    5858    show (MapSL j) = "<MapSL " ++ show j ++ ">" 
    5959 
    60  
    6160foreign import ccall "wrapper" mkFin :: (Ptr JudySL -> IO ()) -> IO (FunPtr (Ptr JudySL -> IO ())) 
    6261 
    6362finalize :: Bool -> Ptr JudySL -> IO () 
    6463finalize need j = do 
     64    putStrLn $ show $ need 
    6565    when need $ do 
    6666        j_ <- newForeignPtr_ j 
    … …  
    7373rawElems = internalMap $ \r _ -> peek r 
    7474 
    75 new_ :: IO (MapSL k a) 
     75dummy :: Refeable a => MapSL k a -> a 
     76dummy = undefined 
     77 
     78new_ :: Refeable a => IO (MapSL k a) 
    7679new_ = do 
    7780    fp <- mallocForeignPtr 
    78     finalize' <- mkFin $ finalize (needGC (undefined :: a)) 
     81    withForeignPtr fp $ flip poke nullPtr 
     82    m <- return $ MapSL fp 
     83 
     84    -- putStrLn $ show $ needGC $ dummy m 
     85    finalize' <- mkFin $ finalize $ needGC $ dummy m 
    7986    addForeignPtrFinalizer finalize' fp  
    80     withForeignPtr fp $ flip poke nullPtr 
    81     return $ MapSL fp 
     87    return m 
    8288 
    8389insert_ :: (Stringable k, Refeable a) => k -> a -> MapSL k a -> IO () 
    … …  
    106112                            return Nothing 
    107113                    else if v /= (fromJust fv) 
    108                              then do when (needGC (undefined :: a)) $ GC.freeRef v' 
     114                             then do when (needGC (fromJust fv)) $ GC.freeRef v' 
    109115                                     x <- toRef (fromJust fv) 
    110116                                     poke r x 
    … …  
    128134        return $ r /= nullPtr 
    129135 
    130 delete_ :: Stringable k => k -> MapSL k a -> IO Bool 
    131 delete_ k (MapSL j) = withForeignPtr j $ \j' -> do 
     136delete_ :: (Stringable k, Refeable a) => k -> MapSL k a -> IO Bool 
     137delete_ k m@(MapSL j) = withForeignPtr j $ \j' -> do 
    132138    j'' <- peek j' 
    133139    useAsCS k $ \k' -> do 
    134         when (needGC (undefined :: a)) $ do 
     140        when (needGC (dummy m)) $ do 
    135141            r <- judySLGet j'' k' judyError 
    136142            if r == nullPtr 

  • third-party/HsJudy/Judy/MiniGC.hs

    r11694 r11716  
    1919    v <- newStablePtr a 
    2020    let v' = ptrToWordPtr $ castStablePtrToPtr v 
    21     alter2 f v' judyGC 
     21    alter f v' judyGC 
    2222    return v' 
    2323   where f Nothing = Just 1 
    … …  
    2626freeRef v = do 
    2727    --putStr "(free? " 
    28     alter2 f v judyGC 
     28    alter f v judyGC 
    2929    x <- member v judyGC 
    3030    if x 
    … …  
    3535         f (Just 1) = Nothing 
    3636         f (Just n) = Just (n-1) 
    37  
    3837 
    3938{- Special implementation of (GCMap Value Int) over JudyL for use in GC -} 
    … …  
    6059        else poke r (toEnum v) 
    6160 
    62 alter2 :: (Maybe Int -> Maybe Int) -> Value -> GCMap -> IO () 
    63 alter2 f k m@(GCMap j) = do 
     61alter :: (Maybe Int -> Maybe Int) -> Value -> GCMap -> IO () 
     62alter f k m@(GCMap j) = do 
    6463    j' <- withForeignPtr j peek 
    6564    r <- judyLGet j' k judyError 

  • third-party/HsJudy/Judy/Refeable.hs

    r11676 r11716  
    1515-- out of "Refeable a" context. Maybe something arch related, dunno. =P 
    1616 
    17 class Dummy a 
    18 instance Dummy a 
     17--class Dummy a 
     18--instance Dummy a 
    1919 
    2020class Refeable a where 
    … …  
    2323    needGC :: a -> Bool 
    2424     
    25 instance Dummy a => Refeable a where 
    26 --instance Refeable a where 
     25--instance Dummy a => Refeable a where 
     26instance Refeable a where 
    2727    toRef = GC.newRef 
    2828    fromRef v = do 

  • third-party/HsJudy/TODO

    r11645 r11716  
    22- Use Judy to implement Pugs IHash substitute. (First patch done, but it's old by now) 
    33- CollectionsM: complete the subset of MapM and uncomment/complete CollectionM. 
     4- See if needGC hack can be improved. It seems its eating CPU time. 
    45 
    56- First RBR test: 1/3 running time when using MapL (via Map2). Not sure 
    … …  
    89- Other missing malloc error checking 
    910- Tests that stress MiniGC (w/ two maps at same time would be nice too) 
    10  
    11 - Good application for Judy: Interning 
    12   http://repetae.net/dw/darcsweb.cgi?r=jhc;a=headblob;f=/Atom.hs 
    13   And check how GHC do it. 
    14  
     11- Check how GHC do interning 
    1512 
    1613# "CRAZY" BUGS