Commit 54170042 authored by Camil Staps's avatar Camil Staps 🙂

Merge branch 'intMapBugs' into 'master'

fix bugs in IntMap caused by the fact that unsinged integers are used in the...

See merge request !260
parents 78d1376e 7ee712fa
Pipeline #26795 passed with stage
in 3 minutes and 9 seconds
definition module Data.IntMap.Base
/**
* @property-bootstrap
* import StdEnv, Data.Func
* // TODO: this is a bad dependency as IntMap.Base should not depend on IntMap.Strict
* from Data.IntMap.Strict import fromList, toList
*
* instance == () where
* == _ _ = True
* instance < () where
* < _ _ = False
*
* derive genShow IntMap
* derive gPrint IntMap
*
* @property-test-with a = ()
*/
from StdOverloaded import class ==
from Data.Maybe import :: Maybe
......@@ -28,6 +44,12 @@ empty :: IntMap a
foldrWithKey :: (Int a b -> b) b !(IntMap a) -> b
/**
* @property correctness: A.list :: [(Int, a)]:
* fromDistinctAscList distinctAscList =.= fromList distinctAscList
* where
* distinctAscList = sort $ removeDup list
*/
fromDistinctAscList :: ![(!Int, !a)] -> IntMap a
union :: !(IntMap a) !(IntMap a) -> IntMap a
......
......@@ -1538,7 +1538,7 @@ nequal _ _ = True
instance Functor IntMap where
fmap f xs = map f xs
link :: Prefix (IntMap a) Prefix (IntMap a) -> IntMap a
link :: !Prefix !(IntMap a) !Prefix !(IntMap a) -> IntMap a
link p1 t1 p2 t2
| zero p1 m = Bin p m t1 t2
| otherwise = Bin p m t2 t1
......@@ -1551,29 +1551,30 @@ bin _ _ l Nil = l
bin _ _ Nil r = r
bin p m l r = Bin p m l r
zero :: Int Mask -> Bool
zero :: !Int !Mask -> Bool
zero i m = (i bitand m) == 0
nomatch :: !Int !Prefix !Mask -> Bool
nomatch i p m = mask i m <> p
match :: Int Prefix Mask -> Bool
match :: !Int !Prefix !Mask -> Bool
match i p m = mask i m == p
mask :: !Int !Mask -> Prefix
mask i m = maskW i m
maskW :: !Int !Int -> Prefix
maskW i m = i bitand (bitnot (m - 1) bitxor m)
mask i m = i bitand (~m bitxor m)
// we have to treat the masks as unsigned ints
// this means that the sign bit has to be inverted to preserve order
shorter :: !Mask !Mask -> Bool
shorter m1 m2 = m1 > m2
shorter m1 m2 = (m1 bitxor signBitOnly) > (m2 bitxor signBitOnly)
branchMask :: !Prefix !Prefix -> Mask
branchMask p1 p2 = highestBitMask (p1 bitxor p2)
highestBitMask :: !Int -> Int
highestBitMask x0 = x6 bitxor (x6 >> 1)
highestBitMask x0 =
// for the right shift `x6` has to be treated as unsigned int, so the highest bit has to be set to 0
x6 bitxor (allExceptSignBit bitand (x6 >> 1))
where
x1 = x0 bitor (x0 >> 1)
x2 = x1 bitor (x1 >> 2)
......@@ -1581,3 +1582,6 @@ where
x4 = x3 bitor (x3 >> 8)
x5 = x4 bitor (x4 >> 16)
x6 = x5 bitor (x5 >> 32)
signBitOnly =: ~2^(IF_INT_64_OR_32 63 31)
allExceptSignBit =: bitnot signBitOnly
definition module Data.IntMap.Strict
/**
* @property-bootstrap
* from StdEnv import removeDup, sort, instance == [a]
* import StdTuple, StdInt
* from Data.Func import $
*
* instance == () where
* == _ _ = True
* instance < () where
* < _ _ = False
*
* @property-test-with a = ()
*/
from Data.Maybe import :: Maybe (..)
from StdClass import class Eq, class Ord
from StdOverloaded import class ==, class <
......@@ -137,6 +151,12 @@ mapWithKey :: !(Int a -> b) !(IntMap a) -> IntMap b
mapSt :: !(a *st -> *(!b, !*st)) !.(IntMap a) !*st -> *(!IntMap b, !*st)
/**
* @property is distinct and sorted: A.list :: [(Int, a)]:
* toList (fromList list) =.= distinctAscList
* where
* distinctAscList = sort $ removeDup list
*/
toList :: !(IntMap a) -> [(!Int, !a)]
toAscList :: !(IntMap a) -> [(!Int, !a)]
......
......@@ -22,5 +22,4 @@ instance PrintOutput File
generic gPrint a :: !a !(PrintState *s) -> (PrintState *s) | PrintOutput s
derive gPrint Int, Real, Char, Bool, String, UNIT, PAIR, EITHER, RECORD of {grd_name}, FIELD of {gfd_name}, CONS of d, OBJECT of {gtd_num_conses,gtd_conses}, [], {!}, {}, (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
//derive bimap PrintState
derive gPrint Int, Real, Char, Bool, String, UNIT, PAIR, EITHER, RECORD of {grd_name}, FIELD of {gfd_name}, CONS of d, OBJECT of {gtd_num_conses,gtd_conses}, [], {!}, {}, (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
......@@ -263,8 +263,8 @@ gPrint{|OBJECT of {gtd_num_conses,gtd_conses}|} f (OBJECT x) st=:{ps_context}
| needParenthesis CtxNonfix ps_context
= printChar '(' $ printString cnsstr $ f x $ printChar ')' @ st
= printString cnsstr $ f x @ st
= f x st
= f x st
gPrint{|()|} _ st = printChar ')' (printChar '(' st)
gPrint{|[]|} f xs st
= printChar '['
$ printList f xs
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment