oisdk · March 3, 2025 11:05 · Mar 3, 2025 · Mar 3, 2025 · Mar 3, 2025 · May 14, 2022
diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -214,6 +214,12 @@ ranges = foldr f [] . rangeSegs
     f (a,au) ((b,bu):xs)
       | au + 1 >= b = (a,bu) : xs
     f (a,au) xs = (a,au) : xs
+
+size' :: Ranges -> Int
+size' None = 0
+size' All = 0
+size' (x :!!: y) = 1 + size' x + size' y
+size' (Seg _ _ _ xs) = 1 + size' xs
 
 enumerate :: Ranges -> [Int]
 enumerate = concatMap (uncurry enumFromTo) . ranges

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -159,7 +159,7 @@ instance Semigroup Ranges where
   (<>) = (+)
 
 instance Monoid Ranges where
-  mempty = 0
+  mempty = None
   mappend = (+)
 
 instance Num Ranges where

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -124,6 +124,9 @@ compl (x :!: y) = compl x :!: compl y
 singleton :: Int -> Ranges
 singleton i = Seg size (trunc i) 0 All
 
+insert :: Int -> Ranges -> Ranges
+insert i = mappend (singleton i)
+
 differAt :: Int -> Int -> Int
 differAt x y = (finiteBitSize x - 1) - countLeadingZeros (xor x y)
 
@@ -151,6 +154,13 @@ slowMember i t = foldr f (All ==) (bits (trunc i)) t
     f _     _ None      = False
     f False k (l :!: _) = k l
     f True  k (_ :!: r) = k r
+
+instance Semigroup Ranges where
+  (<>) = (+)
+
+instance Monoid Ranges where
+  mempty = 0
+  mappend = (+)
 
 instance Num Ranges where
   None      + x         = x
@@ -189,15 +199,25 @@ atMost i = lessThan i + singleton i
 
 range :: Int -> Int -> Ranges
 range lb ub = atLeast lb * atMost ub
-    
-enumerate :: Ranges -> [Int]
-enumerate r = go size 0 r []
+
+rangeSegs :: Ranges -> [(Int,Int)]
+rangeSegs r = go size 0 r []
   where
-    go !n !a All  = (++) [a .. (a + (2^n) - 1)]
+    go !n !a All  = (:) (a,a+(2^n) - 1)
     go !_ !_ None = id
     go !0 !_ _    = id
     go !n !a (l :!: r) = go (n-1) a l . go (n-1) ((2^(n-1)) + a) r
 
+ranges :: Ranges -> [(Int,Int)]
+ranges = foldr f [] . rangeSegs
+  where
+    f (a,au) ((b,bu):xs)
+      | au + 1 >= b = (a,bu) : xs
+    f (a,au) xs = (a,au) : xs
+
+enumerate :: Ranges -> [Int]
+enumerate = concatMap (uncurry enumFromTo) . ranges
+
 instance Arbitrary Ranges where
   arbitrary = sized (go . min size . fromEnum . logBase 2 . (toEnum :: Int -> Double))
     where
@@ -237,6 +257,7 @@ prop_range (InRange lb) (InRange ub) (InRange i) = ((lb <= i) && (i  <= ub)) ===
 prop_all :: Property
 prop_all = range 0 (2^size - 1) === All
 
+
 return []
 
 main :: IO Bool

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -29,6 +29,41 @@ data Ranges
   --                    ^                   ^                   ^
   --                    Length              Path                Offshoots
   deriving (Show)
+
+-- A segment in a tree is a run of children with only one non-leaf child, i.e.:
+--
+--       .
+--       |\
+--       | \
+--       . All
+--      /|
+--     / |
+-- None  .
+--       |\              ~= (None :!: ((... :!: None) :!: All)) :!: All
+--       | \
+--       .  All
+--       |\
+--       | \
+--       .  None
+--      / \
+--      ...
+--
+-- Here, it's wasteful to store this as a tree, since it's really just a linked list.
+-- We can compress it, however, into a few `Int`s, using the `Seg` constructor.
+-- This has 4 fields:
+--
+--   1. The first is the length of the segment. In the example above, it's 4.
+--   2. The second is the path the tree continues down. Above, that's
+--           Left, Right, Left, Left
+--      We can encode this as a bit string, 0100, or the int 4.
+--   3. The last field is the offshoots: the leaves as you walk down the path.
+--      Above, they are:
+--           All, None, All, None
+--      Which encoded is 1010, giving us 10.
+--
+-- This means that instead of 4 constructors we can instead have the single constructor
+--
+--     Seg 4 4 10 ...
 
 instance Eq Ranges where
   None == None = True

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -1,15 +1,25 @@
 {-# LANGUAGE BangPatterns    #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns, PatternSynonyms #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DerivingVia, DerivingStrategies #-}
 {-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
 
 import Data.Bits
 import Data.Bool
 import Test.QuickCheck hiding ((.&.))
 import Control.Applicative
 
+size :: Int
+size = 32
+
 bits :: Int -> [Bool]
-bits i = map (testBit i) [31,30..0]
+bits i = map (testBit i) [size-1,size-2..0]
+
+truncTo :: Int -> Int -> Int
+n `truncTo` t = n .&. (2 ^ t - 1)
+
+trunc :: Int -> Int
+trunc = flip truncTo size
 
 data Ranges
   = None
@@ -18,10 +28,34 @@ data Ranges
   | Seg {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int !Ranges
   --                    ^                   ^                   ^
   --                    Length              Path                Offshoots
-  deriving (Eq, Ord, Show)
+  deriving (Show)
+
+instance Eq Ranges where
+  None == None = True
+  All  == All  = True
+  (xl :!: xr) == (yl :!: yr) = (xl == yl) && (xr == yr)
+  _ == _ = False
+
+instance Ord Ranges where
+  None        <= _    = True
+  _           <= All  = True
+  All         <= _    = False
+  _           <= None = False
+  (xl :!: xr) <= (yl :!: yr) = case compare xl yl of
+    LT -> True
+    GT -> False
+    EQ -> xr <= yr
+
+  compare None None = EQ
+  compare None _    = LT
+  compare _    None = GT
+  compare All  All  = EQ
+  compare All  _    = GT
+  compare _    All  = LT
+  compare (xl :!: xr) (yl :!: yr) = compare xl yl <> compare xr yr
 
 pattern (:!:) :: Ranges -> Ranges -> Ranges
-pattern (:!:) x y <- (unconsBranch -> Just (x, y))
+pattern x :!: y <- (unconsBranch -> Just (x, y))
   where
     All         :!: All         = All
     None        :!: None        = None
@@ -53,27 +87,30 @@ compl All  = None
 compl (x :!: y) = compl x :!: compl y
 
 singleton :: Int -> Ranges
-singleton i = Seg 32 (i .&. (2 ^ (32 :: Int) - 1)) 0 All
+singleton i = Seg size (trunc i) 0 All
 
-headMay :: [a] -> Maybe a
-headMay [] = Nothing
-headMay (x:_) = Just x
-
-fastMember :: Int -> Ranges -> Bool
-fastMember i r = go 31 (i .&. (2 ^ (32 :: Int) - 1)) r
-  where
-    differAt  x y = 63 - countLeadingZeros (xor x y .&. (2 ^ (32 :: Int) - 1))
-    go _ _ All  = True
-    go _ _ None = False
-    go i n (l :!!: r)
-      | testBit n i = go (i-1) (n `clearBit` i) r
-      | otherwise   = go (i-1) (n `clearBit` i) l
-    go i n (Seg l p o r) = 
-      let p' = differAt (shiftL n ((i+1)-l) .&. (2^l - 1)) p 
-      in if p' >= 0 then testBit o p' else go (i-l) (n .&. ((2 ^ ((i-l) + 1)) - 1)) r
+differAt :: Int -> Int -> Int
+differAt x y = (finiteBitSize x - 1) - countLeadingZeros (xor x y)
 
 (?) :: Int -> Ranges -> Bool
-i ? t = foldr f (All ==) (bits (i .&. (2 ^ (32 :: Int) - 1))) t
+(?) n = go (size-1)
+  where
+    go _ All  = True
+    go _ None = False
+    go i (l :!!: r)
+      | testBit n i = go (i-1) r
+      | otherwise   = go (i-1) l
+
+    -- This finds if the needle diverges from the path, and if so it returns the
+    -- offshoot at that point, otherwise (i.e. the path is followed to the end) we
+    -- recurse on the child node.
+    go i (Seg l p o r)
+      | d >= 0 = testBit o d 
+      | otherwise = go (i-l) r
+      where d = differAt ((n `shiftR` ((i+1)-l)) `truncTo` l) p
+
+slowMember :: Int -> Ranges -> Bool
+slowMember i t = foldr f (All ==) (bits (trunc i)) t
   where
     f _     _ All       = True
     f _     _ None      = False
@@ -107,7 +144,7 @@ instance Num Ranges where
   signum _    = 1
 
 atLeast :: Int -> Ranges
-atLeast i = foldr (bool (:!: All) (None :!:)) All (take (32 - countTrailingZeros i) (bits i))
+atLeast i = foldr (bool (:!: All) (None :!:)) All (take (size - countTrailingZeros i) (bits i))
 
 lessThan :: Int -> Ranges
 lessThan i = compl (atLeast i)
@@ -119,39 +156,51 @@ range :: Int -> Int -> Ranges
 range lb ub = atLeast lb * atMost ub
 
 enumerate :: Ranges -> [Int]
-enumerate r = go (32 :: Int) 0 r []
+enumerate r = go size 0 r []
   where
     go !n !a All  = (++) [a .. (a + (2^n) - 1)]
     go !_ !_ None = id
     go !0 !_ _    = id
     go !n !a (l :!: r) = go (n-1) a l . go (n-1) ((2^(n-1)) + a) r
 
 instance Arbitrary Ranges where
-  arbitrary = sized (go . min 32 . fromEnum . logBase 2 . (toEnum :: Int -> Double))
+  arbitrary = sized (go . min size . fromEnum . logBase 2 . (toEnum :: Int -> Double))
     where
       go 0 = elements [All, None]
       go n = frequency [(n, let r = go (n-1) in liftA2 (:!:) r r), (1, elements [All, None])]
 
   shrink (x :!: y) = None : All : x : y : map (uncurry (:!:)) (shrink (x, y))
   shrink _ = []
 
-prop_member :: Int -> Property
-prop_member i = property (i ? singleton i)
+newtype InRange = InRange Int 
+  deriving stock (Eq, Ord) 
+  deriving newtype (Show, Enum, Num, Integral, Real)
+
+instance Bounded InRange where
+  minBound = 0
+  maxBound = 2 ^ size - 1
+
+instance Arbitrary InRange where
+  arbitrary = arbitrarySizedBoundedIntegral
+  shrink = shrinkIntegral
+
+prop_member :: InRange -> Property
+prop_member (InRange i) = property (i ? singleton i)
 
-prop_fastMember :: NonNegative Int -> Ranges -> Property
-prop_fastMember (NonNegative i) r = (i ? r) === fastMember i r
+prop_fastMember :: InRange -> Ranges -> Property
+prop_fastMember (InRange i) r = slowMember i r === (i ? r)
 
-prop_delete :: Int -> Ranges -> Property
-prop_delete i r = not (i ? r) ==> ((singleton i + r) - singleton i) === r
+prop_delete :: InRange -> Ranges -> Property
+prop_delete (InRange i) r = not (i ? r) ==> ((singleton i + r) - singleton i) === r
 
 prop_compl :: Ranges -> Property
 prop_compl r = r + compl r === All
 
-prop_range :: NonNegative Int -> NonNegative Int -> NonNegative Int -> Property
-prop_range (NonNegative lb) (NonNegative ub) (NonNegative i) = ((lb <= i) && (i  <= ub)) === (i ? range lb ub)
+prop_range :: InRange -> InRange -> InRange -> Property
+prop_range (InRange lb) (InRange ub) (InRange i) = ((lb <= i) && (i  <= ub)) === (i ? range lb ub)
 
 prop_all :: Property
-prop_all = range 0 (2^(32 :: Int) - 1) === All
+prop_all = range 0 (2^size - 1) === All
 
 return []
 

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -35,7 +35,7 @@ pattern (:!:) x y <- (unconsBranch -> Just (x, y))
     x           :!: All         = Seg 1 0 1 x
     x           :!: y           = x :!!: y
 {-# COMPLETE (:!:), None, All #-}
-  
+
 unconsBranch :: Ranges -> Maybe (Ranges, Ranges)
 unconsBranch (xs :!!: ys) = Just (xs, ys)
 unconsBranch (Seg l p o r) 
@@ -55,8 +55,25 @@ compl (x :!: y) = compl x :!: compl y
 singleton :: Int -> Ranges
 singleton i = Seg 32 (i .&. (2 ^ (32 :: Int) - 1)) 0 All
 
+headMay :: [a] -> Maybe a
+headMay [] = Nothing
+headMay (x:_) = Just x
+
+fastMember :: Int -> Ranges -> Bool
+fastMember i r = go 31 (i .&. (2 ^ (32 :: Int) - 1)) r
+  where
+    differAt  x y = 63 - countLeadingZeros (xor x y .&. (2 ^ (32 :: Int) - 1))
+    go _ _ All  = True
+    go _ _ None = False
+    go i n (l :!!: r)
+      | testBit n i = go (i-1) (n `clearBit` i) r
+      | otherwise   = go (i-1) (n `clearBit` i) l
+    go i n (Seg l p o r) = 
+      let p' = differAt (shiftL n ((i+1)-l) .&. (2^l - 1)) p 
+      in if p' >= 0 then testBit o p' else go (i-l) (n .&. ((2 ^ ((i-l) + 1)) - 1)) r
+
 (?) :: Int -> Ranges -> Bool
-i ? t = foldr f (All ==) (bits i) t
+i ? t = foldr f (All ==) (bits (i .&. (2 ^ (32 :: Int) - 1))) t
   where
     f _     _ All       = True
     f _     _ None      = False
@@ -121,6 +138,9 @@ instance Arbitrary Ranges where
 prop_member :: Int -> Property
 prop_member i = property (i ? singleton i)
 
+prop_fastMember :: NonNegative Int -> Ranges -> Property
+prop_fastMember (NonNegative i) r = (i ? r) === fastMember i r
+
 prop_delete :: Int -> Ranges -> Property
 prop_delete i r = not (i ? r) ==> ((singleton i + r) - singleton i) === r
 

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -1,94 +1,121 @@
 {-# LANGUAGE BangPatterns    #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ViewPatterns, PatternSynonyms #-}
+{-# OPTIONS_GHC -Wall -fno-warn-name-shadowing #-}
 
 import Data.Bits
 import Data.Bool
-import Test.QuickCheck
+import Test.QuickCheck hiding ((.&.))
 import Control.Applicative
 
 bits :: Int -> [Bool]
 bits i = map (testBit i) [31,30..0]
 
 data Ranges
   = None
-  | Ranges :!: Ranges
+  | !Ranges :!!: !Ranges
   | All
+  | Seg {-# UNPACK #-} !Int {-# UNPACK #-} !Int {-# UNPACK #-} !Int !Ranges
+  --                    ^                   ^                   ^
+  --                    Length              Path                Offshoots
   deriving (Eq, Ord, Show)
+
+pattern (:!:) :: Ranges -> Ranges -> Ranges
+pattern (:!:) x y <- (unconsBranch -> Just (x, y))
+  where
+    All         :!: All         = All
+    None        :!: None        = None
+    None        :!: Seg l p o r = Seg (l+1) (setBit p l) o            r
+    All         :!: Seg l p o r = Seg (l+1) (setBit p l) (setBit o l) r
+    Seg l p o r :!: None        = Seg (l+1) p            o            r
+    Seg l p o r :!: All         = Seg (l+1) p            (setBit o l) r
+    None        :!: y           = Seg 1 1 0 y
+    All         :!: y           = Seg 1 1 1 y
+    x           :!: None        = Seg 1 0 0 x
+    x           :!: All         = Seg 1 0 1 x
+    x           :!: y           = x :!!: y
+{-# COMPLETE (:!:), None, All #-}
 
-(!) :: Ranges -> Ranges -> Ranges
-(!) All  All  = All
-(!) None None = None
-(!) x y = x :!: y
-
+unconsBranch :: Ranges -> Maybe (Ranges, Ranges)
+unconsBranch (xs :!!: ys) = Just (xs, ys)
+unconsBranch (Seg l p o r) 
+  | testBit p (l-1) = Just (bool None All (testBit o (l-1)), tl l p o r)
+  | otherwise       = Just (tl l p o r, bool None All (testBit o (l-1)))
+  where
+    tl 1 _ _ r = r
+    tl l p o r = Seg (l-1) (clearBit p (l-1)) (clearBit o (l-1)) r
+unconsBranch None = Nothing
+unconsBranch All = Nothing
+
 compl :: Ranges -> Ranges
 compl None = All
 compl All  = None
-compl (x :!: y) = compl x ! compl y
+compl (x :!: y) = compl x :!: compl y
 
 singleton :: Int -> Ranges
-singleton = foldr (bool (! None) (None !)) All . bits
-
+singleton i = Seg 32 (i .&. (2 ^ (32 :: Int) - 1)) 0 All
+
+(?) :: Int -> Ranges -> Bool
+i ? t = foldr f (All ==) (bits i) t
+  where
+    f _     _ All       = True
+    f _     _ None      = False
+    f False k (l :!: _) = k l
+    f True  k (_ :!: r) = k r
+
 instance Num Ranges where
-  None + x    = x
-  All  + _    = All
-  x    + None = x
-  _    + All  = All
-  xl :!: xr + yl :!: yr = (xl + yl) ! (xr + yr)
+  None      + x         = x
+  All       + _         = All
+  x         + None      = x
+  _         + All       = All
+  xl :!: xr + yl :!: yr = (xl + yl) :!: (xr + yr)
 
-  None * _    = None
-  All  * x    = x
-  _    * None = None
-  x    * All  = x
-  xl :!: xr * yl :!: yr = (xl * yl) ! (xr * yr)
+  None      * _         = None
+  All       * x         = x
+  _         * None      = None
+  x         * All       = x
+  xl :!: xr * yl :!: yr = (xl * yl) :!: (xr * yr)
 
   fromInteger = singleton . fromEnum
 
   abs = id
 
-  _    - All  = None
-  x    - None = x
-  None - _    = None
-  All  - y    = compl y
-  xl :!: xr - yl :!: yr = (xl - yl) ! (xr - yr)
+  _         - All       = None
+  x         - None      = x
+  None      - _         = None
+  All       - y         = compl y
+  xl :!: xr - yl :!: yr = (xl - yl) :!: (xr - yr)
 
   signum None = 0
   signum _    = 1
 
-(?) :: Int -> Ranges -> Bool
-(?) = foldr f (All==) . bits
-  where
-    f _ _ All  = True
-    f _ _ None = False
-    f False k (l :!: r) = k l
-    f True  k (l :!: r) = k r
-
 atLeast :: Int -> Ranges
-atLeast i = foldr (bool (! All) (None !)) All (take (32 - countTrailingZeros i) (bits i))
+atLeast i = foldr (bool (:!: All) (None :!:)) All (take (32 - countTrailingZeros i) (bits i))
 
 lessThan :: Int -> Ranges
 lessThan i = compl (atLeast i)
 
 atMost :: Int -> Ranges
 atMost i = lessThan i + singleton i
+
+range :: Int -> Int -> Ranges
+range lb ub = atLeast lb * atMost ub
 
 enumerate :: Ranges -> [Int]
-enumerate r = go 32 0 r []
+enumerate r = go (32 :: Int) 0 r []
   where
     go !n !a All  = (++) [a .. (a + (2^n) - 1)]
     go !_ !_ None = id
     go !0 !_ _    = id
     go !n !a (l :!: r) = go (n-1) a l . go (n-1) ((2^(n-1)) + a) r
 
-range :: Int -> Int -> Ranges
-range lb ub = atLeast lb * atMost ub
-
 instance Arbitrary Ranges where
   arbitrary = sized (go . min 32 . fromEnum . logBase 2 . (toEnum :: Int -> Double))
     where
       go 0 = elements [All, None]
-      go n = frequency [(n, let r = go (n-1) in liftA2 (!) r r), (1, elements [All, None])]
+      go n = frequency [(n, let r = go (n-1) in liftA2 (:!:) r r), (1, elements [All, None])]
 
-  shrink (x :!: y) = None : All : x : y : map (uncurry (!)) (shrink (x, y))
+  shrink (x :!: y) = None : All : x : y : map (uncurry (:!:)) (shrink (x, y))
   shrink _ = []
 
 prop_member :: Int -> Property
@@ -100,6 +127,12 @@ prop_delete i r = not (i ? r) ==> ((singleton i + r) - singleton i) === r
 prop_compl :: Ranges -> Property
 prop_compl r = r + compl r === All
 
+prop_range :: NonNegative Int -> NonNegative Int -> NonNegative Int -> Property
+prop_range (NonNegative lb) (NonNegative ub) (NonNegative i) = ((lb <= i) && (i  <= ub)) === (i ? range lb ub)
+
+prop_all :: Property
+prop_all = range 0 (2^(32 :: Int) - 1) === All
+
 return []
 
 main :: IO Bool

diff --git a/RangeTrie.hs b/RangeTrie.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE BangPatterns    #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+import Data.Bits
+import Data.Bool
+import Test.QuickCheck
+import Control.Applicative
+
+bits :: Int -> [Bool]
+bits i = map (testBit i) [31,30..0]
+
+data Ranges
+  = None
+  | Ranges :!: Ranges
+  | All
+  deriving (Eq, Ord, Show)
+
+(!) :: Ranges -> Ranges -> Ranges
+(!) All  All  = All
+(!) None None = None
+(!) x y = x :!: y
+
+compl :: Ranges -> Ranges
+compl None = All
+compl All  = None
+compl (x :!: y) = compl x ! compl y
+
+singleton :: Int -> Ranges
+singleton = foldr (bool (! None) (None !)) All . bits
+
+instance Num Ranges where
+  None + x    = x
+  All  + _    = All
+  x    + None = x
+  _    + All  = All
+  xl :!: xr + yl :!: yr = (xl + yl) ! (xr + yr)
+
+  None * _    = None
+  All  * x    = x
+  _    * None = None
+  x    * All  = x
+  xl :!: xr * yl :!: yr = (xl * yl) ! (xr * yr)
+
+  fromInteger = singleton . fromEnum
+
+  abs = id
+
+  _    - All  = None
+  x    - None = x
+  None - _    = None
+  All  - y    = compl y
+  xl :!: xr - yl :!: yr = (xl - yl) ! (xr - yr)
+
+  signum None = 0
+  signum _    = 1
+
+(?) :: Int -> Ranges -> Bool
+(?) = foldr f (All==) . bits
+  where
+    f _ _ All  = True
+    f _ _ None = False
+    f False k (l :!: r) = k l
+    f True  k (l :!: r) = k r
+
+atLeast :: Int -> Ranges
+atLeast i = foldr (bool (! All) (None !)) All (take (32 - countTrailingZeros i) (bits i))
+
+lessThan :: Int -> Ranges
+lessThan i = compl (atLeast i)
+
+atMost :: Int -> Ranges
+atMost i = lessThan i + singleton i
+
+enumerate :: Ranges -> [Int]
+enumerate r = go 32 0 r []
+  where
+    go !n !a All  = (++) [a .. (a + (2^n) - 1)]
+    go !_ !_ None = id
+    go !0 !_ _    = id
+    go !n !a (l :!: r) = go (n-1) a l . go (n-1) ((2^(n-1)) + a) r
+
+range :: Int -> Int -> Ranges
+range lb ub = atLeast lb * atMost ub
+
+instance Arbitrary Ranges where
+  arbitrary = sized (go . min 32 . fromEnum . logBase 2 . (toEnum :: Int -> Double))
+    where
+      go 0 = elements [All, None]
+      go n = frequency [(n, let r = go (n-1) in liftA2 (!) r r), (1, elements [All, None])]
+
+  shrink (x :!: y) = None : All : x : y : map (uncurry (!)) (shrink (x, y))
+  shrink _ = []
+
+prop_member :: Int -> Property
+prop_member i = property (i ? singleton i)
+
+prop_delete :: Int -> Ranges -> Property
+prop_delete i r = not (i ? r) ==> ((singleton i + r) - singleton i) === r
+
+prop_compl :: Ranges -> Property
+prop_compl r = r + compl r === All
+
+return []
+
+main :: IO Bool
+main = $quickCheckAll
No results found