From 02e6cd7687a0acba65b47f12db45bea0db604fdb Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Thu, 22 Dec 2016 02:10:30 -0400
Subject: - Fixed a bug in the way hierarchy->base demotion worked for Dict
 nodes. - Fixed a bug in a test for lux/data/struct/list.

---
 stdlib/source/lux/data/struct/dict.lux   | 26 ++++++++++++++------------
 stdlib/source/lux/data/struct/set.lux    | 18 +++++++++---------
 stdlib/test/test/lux/data/struct/set.lux |  2 +-
 3 files changed, 24 insertions(+), 22 deletions(-)

(limited to 'stdlib')

diff --git a/stdlib/source/lux/data/struct/dict.lux b/stdlib/source/lux/data/struct/dict.lux
index 38cfe7efa..56ab6ca64 100644
--- a/stdlib/source/lux/data/struct/dict.lux
+++ b/stdlib/source/lux/data/struct/dict.lux
@@ -228,18 +228,20 @@
 ## nodes to save space.
 (def: (demote-hierarchy except-idx [h-size h-array])
   (All [k v] (-> Index (Hierarchy k v) [BitMap (Base k v)]))
-  (List/fold (lambda [idx (^@ node [bitmap base])]
-               (case (array;get idx h-array)
-                 #;None            node
-                 (#;Some sub-node) (if (n.= except-idx idx)
-                                     node
-                                     [(set-bit-position (->bit-position idx) bitmap)
-                                      (array;put idx (#;Left sub-node) base)])
-                 ))
-             [clean-bitmap
-              (: (Base ($ +0) ($ +1))
-                 (array;new (n.dec h-size)))]
-             (list;indices (array;size h-array))))
+  (product;right (List/fold (lambda [idx [insertion-idx node]]
+                              (let [[bitmap base] node]
+                                (case (array;get idx h-array)
+                                  #;None            [insertion-idx node]
+                                  (#;Some sub-node) (if (n.= except-idx idx)
+                                                      [insertion-idx node]
+                                                      [(n.inc insertion-idx)
+                                                       [(set-bit-position (->bit-position idx) bitmap)
+                                                        (array;put insertion-idx (#;Left sub-node) base)]])
+                                  )))
+                            [+0 [clean-bitmap
+                                 (: (Base ($ +0) ($ +1))
+                                    (array;new (n.dec h-size)))]]
+                            (list;indices (array;size h-array)))))
 
 ## When #Base nodes grow too large, they're promoted to #Hierarchy to
 ## add some depth to the tree and help keep it's balance.
diff --git a/stdlib/source/lux/data/struct/set.lux b/stdlib/source/lux/data/struct/set.lux
index 44a383e7c..5f828ba43 100644
--- a/stdlib/source/lux/data/struct/set.lux
+++ b/stdlib/source/lux/data/struct/set.lux
@@ -35,13 +35,21 @@
   (All [a] (-> (Set a) a Bool))
   (dict;contains? elem set))
 
+(def: #export to-list
+  (All [a] (-> (Set a) (List a)))
+  dict;keys)
+
+(def: #export (from-list Hash<a> xs)
+  (All [a] (-> (Hash a) (List a) (Set a)))
+  (List/fold add (new Hash<a>) xs))
+
 (def: #export (union xs yx)
   (All [a] (-> (Set a) (Set a) (Set a)))
   (dict;merge xs yx))
 
 (def: #export (difference subs base)
   (All [a] (-> (Set a) (Set a) (Set a)))
-  (List/fold remove base (dict;keys subs)))
+  (List/fold remove base (to-list subs)))
 
 (def: #export (intersection filter base)
   (All [a] (-> (Set a) (Set a) (Set a)))
@@ -55,14 +63,6 @@
   (All [a] (-> (Set a) Bool))
   (n.= +0 (dict;size set)))
 
-(def: #export to-list
-  (All [a] (-> (Set a) (List a)))
-  dict;keys)
-
-(def: #export (from-list Hash<a> xs)
-  (All [a] (-> (Hash a) (List a) (Set a)))
-  (List/fold add (new Hash<a>) xs))
-
 (def: #export (sub? super sub)
   (All [a] (-> (Set a) (Set a) Bool))
   (list;every? (member? super) (to-list sub)))
diff --git a/stdlib/test/test/lux/data/struct/set.lux b/stdlib/test/test/lux/data/struct/set.lux
index bc284dd4a..27d80959f 100644
--- a/stdlib/test/test/lux/data/struct/set.lux
+++ b/stdlib/test/test/lux/data/struct/set.lux
@@ -59,7 +59,7 @@
 
       (assert "After substracting a set A from another B, no member of A can be a member of B."
               (let [sub (&;difference setR setL)]
-                (not (list;any? (&;member? setL) (&;to-list setR)))))
+                (not (list;any? (&;member? sub) (&;to-list setR)))))
 
       (assert "Every member of a set must be identifiable."
               (and (not (&;member? setL non-member))
-- 
cgit v1.2.3