Use singular "slset" instead of plural "slsets"

1 files changed, 0 insertions, 225 deletions

diff --git a/slsets.scm b/slsets.scm
deleted file mode 100644
index ce8f67c..0000000
--- a/slsets.scm
+++ /dev/null
@@ -1,225 +0,0 @@
-;;
-;; Lists of symbols as sets
-;;
-;; Essentially, this provides specialized versions of SRFI-1's lset
-;; operations for symbols but with linear instead of quadratic time
-;; complexity.  It's even faster than using a side hash table, unless
-;; the symbols already have large plists associated with them.
-;;
-(declare (disable-interrupts))
-
-(module slsets
-    (slset<= slset= slset-adjoin
-     slset-difference slset-intersection
-     slset-difference+intersection
-     slset-union slset-xor
-     slset-deduplicate
-     slset-delete slset-contains?
-
-     with-reified-slset reified-slset? reified-slset->slset
-     reified-slset-adjoin! reified-slset-delete! reified-slset-contains?)
-
-(import scheme (chicken base) (chicken plist))
-
-(define-inline (mark! x marking)
-  (when (symbol? x) (put! x marking #t)))
-
-(define-inline (mark-list! lst marking)
-  (for-each (lambda (x) (mark! x marking)) lst))
-
-(define-inline (unmark! x marking)
-  (when (symbol? x) (remprop! x marking)))
-
-(define-inline (unmark-list! lst marking)
-  (for-each (lambda (x) (unmark! x marking)) lst))
-
-(define-inline (with-marked-list lst fun)
-  (let ((marking (gensym 'm)))
-    (dynamic-wind
-        (lambda () (mark-list! lst marking))
-        (lambda () (fun marking))
-        (lambda () (unmark-list! lst marking)))))
-
-(define-inline (every? pred lst)
-  (let lp ((lst lst))
-    (cond ((null? lst) #t)
-          ((not (pred (car lst))) #f)
-          (else (lp (cdr lst))))))
-
-(define-inline (marked? x marking)
-  (and (symbol? x) (get x marking)))
-
-(define (last lst)
-  (if (null? (cdr lst))
-      (car lst)
-      (last (cdr lst))))
-
-(define-inline (filter pred lst)
-  (let lp ((lst lst)
-           (res '()))
-    (cond ((null? lst) (reverse res))
-          ((not (pred (car lst))) (lp (cdr lst) res))
-          (else (lp (cdr lst) (cons (car lst) res))))))
-
-(define (slset<= . lsts)
-  (or (null? lsts)
-      (let ((last-list (last lsts)))
-       (with-marked-list last-list
-                         (lambda (m)
-                           (every? (lambda (lst)
-                                     (or (eq? lst last-list) ; Avoid filtering out this one and building a new list
-                                         (every? (lambda (x) (marked? x m)) lst)))
-                                   lsts))))))
-
-(define (slset= . lsts)
-  (or (null? lsts)
-      (let ((lst (car lsts))
-            (lsts (cdr lsts)))
-        (every? (lambda (l)
-                  (and (slset<= lst l) (slset<= l lst)))
-                lsts))))
-
-(define (slset-adjoin lst . els)
-  (with-marked-list lst
-                    (lambda (m)
-                      (dynamic-wind
-                          void
-                          (lambda ()
-                            (let lp ((lst lst)
-                                     (els els))
-                              (cond ((null? els) lst)
-                                    ((marked? (car els) m) (lp lst (cdr els)))
-                                    (else (mark! (car els) m)
-                                          (lp (cons (car els) lst) (cdr els))))))
-                          (lambda ()
-                            (unmark-list! els m))))))
-
-(define (slset-difference lst . lsts)
-  (let lp ((lsts lsts)
-           (res lst))
-    (if (null? lsts)
-        res
-        (lp (cdr lsts)
-            (with-marked-list (car lsts) (lambda (m) (filter (lambda (x) (not (marked? x m))) res)))))))
-
-(define (slset-intersection lst . lsts)
-  (let lp ((lsts lsts)
-           (res lst))
-    (if (null? lsts)
-        res
-        (lp (cdr lsts)
-            (with-marked-list (car lsts)
-                              (lambda (m) (filter (lambda (x) (marked? x m)) res)))))))
-
-;; TODO: Make this faster
-(define (slset-difference+intersection lst . lsts)
-  (values (apply slset-difference lst lsts)
-          (apply slset-intersection lst lsts)))
-
-;; NOTE: Can't use mark-list here, so roll our own!
-;; TODO: Clean up if there's an error cdring down any of these lists?
-(define (slset-union . lsts)
-  (if (null? lsts)
-      '()
-      (let ((marking (gensym 'm))
-            (first-list (car lsts)))
-        (mark-list! first-list marking)
-        (let lp ((lsts (cdr lsts))
-                 (res first-list))
-          (if (null? lsts)
-              (begin (unmark-list! res marking)
-                     res)
-              (let lp2 ((lst (car lsts))
-                        (res res))
-                (if (null? lst)
-                    (lp (cdr lsts) res)
-                    (let ((x (car lst)))
-                      (if (marked? x marking)
-                          (lp2 (cdr lst) res)
-                          (begin (mark! x marking)
-                                 (lp2 (cdr lst) (cons x res))))))))))))
-
-(define (slset-xor . lsts)
-  (let lp ((lsts lsts)
-           (res '()))
-    (if (null? lsts)
-        res
-        (lp (cdr lsts)
-            (append (slset-difference res (car lsts))
-                    (slset-difference (car lsts) res))))))
-
-;; NOTE: Can't use mark-list here, so roll our own!
-;; TODO: Clean up if there's an error cdring down the list?
-(define (slset-deduplicate lst)
-  (let ((marking (gensym 'm)))
-    (let lp ((lst lst)
-             (res '()))
-      (if (null? lst)
-          (begin (unmark-list! res marking)
-                 (reverse res))
-          (let ((x (car lst)))
-            (cond ((marked? x marking)
-                   (lp (cdr lst) res))
-                  (else (mark! x marking)
-                        (lp (cdr lst) (cons x res)))))))))
-
-;; These are not really necessary - one can use memq and srfi-1's delete.
-;; But they're supplied so we have the full gamut of set operations.
-;; Also, deletion is a bit more ergonomic as it accepts multiple arguments.
-(define (slset-contains? slset el)
-  (and (memq el slset) #t))
-
-(define (slset-delete slset . els)
-  (with-marked-list els
-                    (lambda (m)
-                      (filter (lambda (x) (not (marked? x m))) slset))))
-
-(define-record-type :reified-slset
-  (reified-slset marking slset)
-  reified-slset?
-  (marking reified-slset-marking)
-  (slset reified-slset-list reified-slset-list-set!))
-
-(define reified-slset->slset reified-slset-list)
-
-(define (with-reified-slset lst fun)
-  ;; Note: we can't use with-marked-list here because the reified
-  ;; slset will be mutated in-place, so the enter/leave thunks must
-  ;; extract the *current* list from the reified slset every time.
-  (let* ((marking (gensym 'm))
-         (rs (reified-slset marking lst)))
-    (dynamic-wind
-        (lambda () (mark-list! (reified-slset-list rs) marking))
-        (lambda ()
-          (receive res (fun rs)
-            (apply values (reified-slset-list rs) res)))
-        (lambda () (unmark-list! (reified-slset-list rs) marking)))))
-
-(define (reified-slset-adjoin! rs . els)
-  (let ((m (reified-slset-marking rs)))
-    (let lp ((lst (reified-slset-list rs))
-             (els els))
-      (cond ((null? els)
-             (reified-slset-list-set! rs lst)
-             rs)
-            ((marked? (car els) m) (lp lst (cdr els)))
-            (else (mark! (car els) m)
-                  (lp (cons (car els) lst) (cdr els)))))))
-
-;; NOTE: Deleting elements not already occurring in the list is O(1)
-(define (reified-slset-delete! rs . els)
-  (let* ((m1 (reified-slset-marking rs))
-         (els (filter (lambda (e) (not (marked? m1 e))) els)))
-    (unless (null? els)
-      (let ((lst (with-marked-list els
-                                   (lambda (m2)
-                                     (filter (lambda (el) (not (marked? el m2)))
-                                             (reified-slset-list rs))))))
-        (for-each (lambda (e) (unmark! e m1)) els)
-        (reified-slset-list-set! rs lst)))
-    rs))
-
-(define (reified-slset-contains? rs el)
-  (marked? el (reified-slset-marking rs)))
-
-)