Finish initial list set implementation.

src/util-set-list.scm

@@ -30,24 +30,25 @@
  (
   TAG-LSET
 
-  ;;make-lset
+  make-lset
-  ;;lset-add
+  lset-add
-  ;;lset-remove
+  lset-remove
 
-  ;;lset-member?
+  lset-member?
   
-  ;;lset-merge
+  list->lset
-  ;;lset-intersect
+  lset->list
-  ;;lset-subtract
 
-  ;;list->lset
+  lset-merge
-  ;;lset->list
+  lset-intersect
+  lset-subtract
   )
 
  (import scheme
 	 (chicken string)
 	 (chicken random))
 
+ ;; Tag used for identifying list sets from this module
  (define TAG-LSET
    (string-intersperse
     (cons "LSET-"
@@ -62,8 +63,106 @@
 		 (make-string 8)))))
     ""))
 
+ ;; Creates new list set using given equality procedure
+ (define (make-lset equality?)
+   (list TAG-LSET
+	 (list equality?)))
+
+ ;; Convenience accessors
+ (define lset-meta cadr)
+ (define lset-equality? caadr)
+ (define lset-list cddr)
+
+ ;; Returns true if given element is in the list
+ (define (lset-member? ls el)
+   (let ((equality? (lset-equality? ls)))
+     (let loop ((els (lset-list ls)))
+       (if (null? els)
+	   #f
+	   (if (equality? (car els) el)
+	       #t
+	       (loop (cdr els)))))))
+
+ ;; Adds given element to the list set
+ (define (lset-add ls el)
+   (if (lset-member? ls el)
+       ls
+       (cons TAG-LSET
+	     (cons (lset-meta ls)
+		   (cons el
+			 (lset-list ls))))))
+
+ ;; Remove given element from the set
+ (define (lset-remove ls el)
+   (let ((equality? (lset-equality? ls)))
+     (let loop ((els (lset-list ls))
+		(res '()))
+       (if (null? els)
+	   (cons TAG-LSET
+		 (cons (lset-meta ls)
+		       res))
+	   (loop (cdr els)
+		 (if (equality? (car els) el)
+		     res
+		     (cons (car els) res)))))))
+
+ ;; Converts given list to a set with unique members
+ (define (list->lset lst equality?)
+   (let loop ((lst lst)
+	      (ls (make-lset equality?)))
+     (if (null? lst)
+	 ls
+	 (loop (cdr lst)
+	       (lset-add ls (car lst))))))
+
+ ;; Converts the list set to plain list (effectively returning the
+ ;; internal list)
+ (define lset->list lset-list)
+
+ ;; Merges two (compatible) list sets
+ (define (lset-merge ls1 ls2)
+   (let loop ((lst (lset-list ls2))
+	      (ls ls1))
+     (if (null? lst)
+	 ls
+	 (loop (cdr lst)
+	       (lset-add ls (car lst))))))
+
+ ;; Returns list set intersection (set of elements in both sets)
+ (define (lset-intersect ls1 ls2)
+   (let loop ((lst (lset-list ls2))
+	      (ls (make-lset (lset-equality? ls1))))
+     (if (null? lst)
+	 ls
+	 (let ((el (car lst)))
+	   (loop (cdr lst)
+		 (if (lset-member? ls1 el)
+		     (lset-add ls el)
+		     ls))))))
+
+ ;; Returns the set ls1 without elements in ls2
+ (define (lset-subtract ls1 ls2)
+   (let loop ((lst (lset-list ls2))
+	      (ls ls1))
+     (if (null? lst)
+	 ls
+	 (loop (cdr lst)
+	       (lset-remove ls (car lst))))))
+
  )
 
 (import util-set-list)
 
 (print TAG-LSET)
+(print (make-lset string=?))
+(define ls (make-lset string=?))
+(print ls)
+(define ls1 (lset-add ls "a"))
+(print ls1)
+(define ls2 (lset-add ls1 "a"))
+(print ls2)
+(define ls3 (lset-add ls2 "b"))
+(print ls3)
+(define ls4 (lset-remove ls3 "a"))
+(print ls4)
+(print (list->lset '("asdf" "qwer" "asdf" "xcvv" "asdf" "qwer" "lkjh") string=?))