Corrected bug: use shadowing-import-from SET into INDEX-SET.

Pascal J. Bourguignon [2013-05-26 00:23]
Corrected bug: use shadowing-import-from SET into INDEX-SET.
Filename
common-lisp/cesarum/index-set.lisp
common-lisp/cesarum/set.lisp
diff --git a/common-lisp/cesarum/index-set.lisp b/common-lisp/cesarum/index-set.lisp
index 432a10e..d766686 100644
--- a/common-lisp/cesarum/index-set.lisp
+++ b/common-lisp/cesarum/index-set.lisp
@@ -40,9 +40,8 @@
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SEQUENCE"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.UTILITY"
         "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET")
-  (:shadow "MERGE" "INTERSECTION" "UNION")
-  (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET" "INCLUDE")
-
+  (:shadowing-import-from "COM.INFORMATIMAGO.COMMON-LISP.CESARUM.SET"
+                          "INCLUDE"  "MERGE" "INTERSECTION" "UNION")
   (:export
    "CONTAINS" "CARDINAL" "EMPTYP" "MINIMUM" "MAXIMUM"
    "MAKE-COLLECTOR" "MAP-ELEMENTS" "THEREIS" "THEREIS1" "ALWAYS"
@@ -680,7 +679,8 @@ License:

 (defmethod subtract              ((destination-set index-set) (source-set index-set))
   (setf (slot-value destination-set 'ranges)
-        (difference-ranges (slot-value destination-set 'ranges) (slot-value source-set 'ranges)))
+        (difference-ranges (slot-value destination-set 'ranges)
+                           (slot-value source-set 'ranges)))
   destination-set)


diff --git a/common-lisp/cesarum/set.lisp b/common-lisp/cesarum/set.lisp
index 88de14c..6bd3a34 100644
--- a/common-lisp/cesarum/set.lisp
+++ b/common-lisp/cesarum/set.lisp
@@ -170,16 +170,19 @@ RETURN: A collector for the RESULT-TYPE.
     (declare (ignorable result-type))
     (lambda (&optional set (element nil add-element-p))
       (if add-element-p
-          (cons element set)
+          (if (member element set)
+              set
+              (cons element set))
           '())))
   (:method ((result-type (eql 'vector)))
     (declare (ignorable result-type))
     (lambda (&optional set (element nil add-element-p))
       (if add-element-p
           (progn
-            (vector-push-extend element set (length set))
+            (unless (find element set)
+              (vector-push-extend element set (length set)))
             set)
-          (make-array 2 :element-type 'integer :adjustable t :fill-pointer 0)))))
+          (make-array 2 :adjustable t :fill-pointer 0)))))


 (defmacro collecting-result ((collect-operator-name result-type) &body body)
@@ -278,6 +281,8 @@ RETURN:         Whether the two sets contains the same elements.
          (is-subset set2 set1))))


+
+
 (defgeneric is-subset             (subset set)
   (:documentation "
 RETURN:         Whether SUBSET is a subset of SET.
@@ -287,6 +292,7 @@ RETURN:         Whether SUBSET is a subset of SET.
          (always (curry (function contains) set) subset))))


+
 (defgeneric is-strict-subset      (subset set)
   (:documentation "
 RETURN:         Whether SUBSET is a strict subset of SET.
@@ -636,6 +642,7 @@ RETURN: SET.
                                  (test-set 1 2 3))))))


+
 (define-test test/union (operator test-class)
   (flet ((test-set (&rest elements)
            (copy test-class elements)))
@@ -690,6 +697,9 @@ RETURN: SET.
           (test-set 1 2 3 4 5 11 12 13 14 15))))


+
+
+
 (define-test test/intersection (operator test-class)
   (flet ((test-set (&rest elements)
            (copy test-class elements)))
@@ -775,4 +785,5 @@ RETURN: SET.

 (test/all)

+
 ;;;; THE END ;;;;
ViewGit