Commit 064b5aa9 authored by Steffen Michels's avatar Steffen Michels

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

fix bugs in IntMap caused by the fact that unsinged integers are used in the original Haskell implementation, whereas in Clean we have to used signed integers; add two propertieswhich revealed the fixed bugs
parent 78d1376e
Pipeline #26702 failed with stage
in 3 minutes and 4 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}, [], {!}, {}, (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
......@@ -281,7 +281,7 @@ gPrint{|{!}|} f xs st
$ printList f [ x \\ x <-: xs]
$ printChar '}'
@ st
derive gPrint (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
derive gPrint (), (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
//derive gOutput (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,)
......
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