Changeset 11899 for third-party

Show
Ignore:
Timestamp:
08/03/06 18:34:00 (2 years ago)
Author:
cmarcelo
Message:

* Judy.Map2: Take* primitives and a missing file required for testing.

Location:
third-party/HsJudy
Files:
1 added
2 modified

Legend:

Unmodified
Added
Removed

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

    r11831 r11899  
    33module Judy.Map2 ( 
    44    Map2 (..), 
    5     swapMaps, freeze, toRevList 
     5    swapMaps, freeze, 
     6    toRevList, 
     7    size, 
     8    takeFirstElems, takeFirst, 
     9    takeLastElems, takeLast 
    610) where 
    711 
    … …  
    148152    return $ r /= 0 
    149153 
     154size :: Map2 k a -> IO Int 
     155size (Map2 j) = withForeignPtr j $ \j' -> do 
     156    jj <- peek j' 
     157    r <- judyLCount jj 0 (-1) judyError 
     158    return $ fromEnum r 
     159 
     160 
    150161 
    151162fromList_ :: (ReversibleHashIO k, Refeable a) => [(k,a)] -> IO (Map2 k a) 
    … …  
    155166    return m 
    156167 
    157 --count j i1 i2 = withForeignPtr j $ \j -> do 
    158 --    jj <- peek j 
    159 --    r <- judyLCount jj i1 i2 judyError 
    160 --    return $ r 
    161  
    162  
    163168internalMap' :: (Ptr Value -> Ptr Value -> IO b) -> Map2 k a -> IO [b] 
    164169internalMap' f (Map2 j) = do 
    … …  
    173178                        loop judyLNext (x:xs) 
    174179        loop judyLFirst [] 
     180 
     181withLast :: (Ptr Value -> Ptr Value -> IO b) -> Int -> Map2 k a -> IO [b] 
     182withLast f n (Map2 j) = do 
     183    jj <- withForeignPtr j peek 
     184    alloca $ \vp -> do 
     185        poke vp (-1) 
     186        let loop _ xs 0 = return xs 
     187            loop act xs n' = do 
     188            r <- act jj vp judyError 
     189            if r == nullPtr 
     190                then return xs 
     191                else do x <- f r vp 
     192                        loop judyLPrev (x:xs) (n'-1) 
     193        loop judyLLast [] n 
     194 
     195-- FIXME: use a less obscure syntax =P 
     196takeLast :: (ReversibleHashIO k, Refeable a) => Int -> Map2 k a -> IO [(k,a)] 
     197takeLast n m = do 
     198    withLast (\r vp -> do { k <- peek vp >>= unHashIO; v <- peek r >>= fromRef; return (k,v) }) n m 
     199 
     200takeLastElems :: Refeable a => Int -> Map2 k a -> IO [a] 
     201takeLastElems n m = do 
     202    withLast (\r _ -> peek r >>= fromRef) n m 
     203 
     204 
     205 
     206 
     207withFirst :: (Ptr Value -> Ptr Value -> IO b) -> Int -> Map2 k a -> IO [b] 
     208withFirst f n (Map2 j) = do 
     209    jj <- withForeignPtr j peek 
     210    alloca $ \vp -> do 
     211        poke vp (0 :: Value) 
     212        let loop _ xs 0 = return xs 
     213            loop act xs n' = do 
     214            r <- act jj vp judyError 
     215            if r == nullPtr 
     216                then return xs 
     217                else do x <- f r vp 
     218                        loop judyLNext (x:xs) (n'-1) 
     219        loop judyLFirst [] n 
     220 
     221-- FIXME: For n < size, is better use this approach, but for 
     222-- n ~= size would be better to use LPrev and LLast and dont reverse. 
     223 
     224 
     225-- FIXME: use a less obscure syntax =P 
     226takeFirst :: (ReversibleHashIO k, Refeable a) => Int -> Map2 k a -> IO [(k,a)] 
     227takeFirst n m = do 
     228    l <- withFirst (\r vp -> do { k <- peek vp >>= unHashIO; v <- peek r >>= fromRef; return (k,v) }) n m 
     229    return $ reverse l 
     230 
     231takeFirstElems :: Refeable a => Int -> Map2 k a -> IO [a] 
     232takeFirstElems n m = do 
     233    l <- withFirst (\r _ -> peek r >>= fromRef) n m 
     234    return $ reverse l 
    175235 
    176236internalMap :: (Ptr Value -> Ptr Value -> IO b) -> Map2 k a -> IO [b] 

  • third-party/HsJudy/tests/TestMap2.hs

    r11831 r11899  
    1010 
    1111main = no_plan $ do 
    12     testSimple 
    13     testDelete 
    14     testOverwrite 
    15     testMember 
    16     testElems 
    17     testKeys 
    18     testStringValue 
    19     testStringValueDel 
    20     testSwapMaps 
    21     testAlter 
    22     testRevList 
    2312 
    24 testSimple = do 
    25     say "Simple" 
     13t "Simple" $ do 
    2614    s <- new :: IO (Map2 Int Int) 
    2715    lookup 1 s    .=> Nothing 
    … …  
    2917    lookup 1 s    .=> Just 42 
    3018 
    31 testDelete = do 
    32     say "Delete" 
     19t "Delete" $ do 
    3320    s <- new :: IO (Map2 Int Int) 
    3421    lookup 3 s    .=> Nothing 
    … …  
    4128    lookup 37 s .=> Just 59 
    4229 
    43 testOverwrite = do 
    44     say "Overwrite" 
     30t "Overwrite" $ do 
    4531    s <- new :: IO (Map2 Int Int) 
    4632    insert 3 1234 s 
    … …  
    5036    lookup 3 s .=> Just 42 
    5137 
    52 testMember = do 
    53     say "Member" 
     38t "Member" $ do 
    5439    s <- new :: IO (Map2 Int Int) 
    5540    member 3 s     .=> False 
    … …  
    6045    member 3 s     .=> True 
    6146 
    62 testElems = do 
    63     say "Elems" 
     47t "Elems" $ do 
    6448    s <- new :: IO (Map2 Int Int) 
    6549    elems s .=> [] 
    … …  
    6953    elems s .=> [2,42,1] 
    7054 
    71 testKeys = do 
    72     say "Keys" 
     55t "Keys" $ do 
    7356    s <- new :: IO (Map2 Int Int) 
    7457    keys s .-= [] 
    … …  
    8164    keys s .=> [0,3] 
    8265 
    83 testStringValue = do 
    84     say "StringValue" 
     66t "StringValue" $ do 
    8567    s <- new :: IO (Map2 Int String) 
    8668    toList s .-= [] 
    … …  
    9577    lookup 59 s .=> Just "i am not a number" 
    9678 
    97 testStringValueDel = do 
    98     say "StringValueDel" 
     79t "StringValueDel" $ do 
    9980    s <- new :: IO (Map2 Int String) 
    10081    toList s .-= [] 
    … …  
    11192    lookup 23 s .=> Just "string" 
    11293 
    113 testSwapMaps = do 
    114     say "SwapMaps" 
     94t "SwapMaps" $ do 
    11595    m1 <- fromList [(1,2),(2,3),(4,7)] :: IO (J.Map2 Int Int) 
    11696    m2 <- fromList [(1,42),(2,42),(3,42)] :: IO (J.Map2 Int Int) 
    … …  
    124104    lookup 3 m2 .=> Nothing 
    125105 
    126 testAlter = do 
    127     say "Alter" 
     106t "Alter" $ do 
    128107    m <- fromList [(1,2), (2,3), (4,5)] :: IO (J.Map2 Int Int) 
    129108    lookup 1 m .=> Just 2 
    … …  
    139118    lookup 1 m .=> Nothing 
    140119 
    141 testRevList = do 
    142     say "RevList" 
     120t "RevList" $ do 
    143121    let l = [(1,2), (2,3), (4,5)] 
    144122    m <- fromList l :: IO (J.Map2 Int Int) 
    … …  
    148126    J.toRevList m .=> reverse (sort $ (3,10):l) 
    149127 
     128t "Size" $ do 
     129    let l = [0..] `zip` [1..20] 
     130    m <- fromList l :: IO (J.Map2 Int Int) 
     131    J.size m .=> 20 
     132    delete 0 m 
     133    delete 1 m 
     134    J.size m .=> 18 
     135    insert 2 3 m 
     136    insert 21 3 m 
     137    J.size m .=> 19 
     138 
     139t "TakeFirst et al" $ do 
     140    let l = [0..100] `zip` [100..] 
     141    m <- fromList l :: IO (J.Map2 Int Int) 
     142    J.takeFirstElems 5 m  .=> [100..104] 
     143    J.takeFirst 5 m       .=> [0..] `zip` [100..104] 
     144    J.takeFirstElems 10 m .=> [100..109] 
     145    delete 0 m 
     146    delete 1 m 
     147    J.takeFirstElems 3 m  .=> [102..104] 
     148    J.takeFirst 3 m       .=> [2..4] `zip` [102..104] 
     149 
     150t "TakeLast et al" $ do 
     151    let l = [0..100] `zip` [100..] 
     152    m <- fromList l :: IO (J.Map2 Int Int) 
     153    J.takeLastElems 5 m  .=> [196..200] 
     154    J.takeLast 5 m       .=> [96..] `zip` [196..200] 
     155    J.takeLastElems 10 m .=> [191..200] 
     156    delete 100 m 
     157    delete 99 m 
     158    J.takeLastElems 3 m  .=> [196..198] 
     159    J.takeLast 3 m       .=> [96..] `zip` [196..198] 
     160 
    150161-- TODO: test some crazy haskell type as value (to check stableptrs) 
    151