Add some operations for new regset abstraction.

diff --git a/v7/src/compiler/base/sets.scm b/v7/src/compiler/base/sets.scm
index 2d3340ff5ec10b2eb5fac48794ad8d7c5f75ed37..7c5497fcf4eab3d130c74ecd035c5e58833d2c93 100644 (file)
--- a/v7/src/compiler/base/sets.scm
+++ b/v7/src/compiler/base/sets.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/sets.scm,v 1.1 1987/03/19 00:44:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/compiler/base/sets.scm,v 1.2 1987/06/26 02:22:12 cph Exp $
 
 Copyright (c) 1987 Massachusetts Institute of Technology
 
@@ -118,4 +118,54 @@ MIT in each case. |#
     (cond ((null? x) '())
          ((memv (car x) y) (loop (cdr x)))
          (else (cons (car x) (loop (cdr x))))))
-  (loop x))
\ No newline at end of file
+  (loop x))
+
+(define (eq-set-intersection x y)
+  (define (loop x)
+    (cond ((null? x) '())
+         ((memq (car x) y) (cons (car x) (loop (cdr x))))
+         (else (loop (cdr x)))))
+  (loop x))
+
+(define (eqv-set-intersection x y)
+  (define (loop x)
+    (cond ((null? x) '())
+         ((memv (car x) y) (cons (car x) (loop (cdr x))))
+         (else (loop (cdr x)))))
+  (loop x))
+\f
+(define (eq-set-disjoint? x y)
+  (define (loop x)
+    (cond ((null? x) true)
+         ((memq (car x) y) false)
+         (else (loop (cdr x)))))
+  (loop x))
+
+(define (eqv-set-disjoint? x y)
+  (define (loop x)
+    (cond ((null? x) true)
+         ((memv (car x) y) false)
+         (else (loop (cdr x)))))
+  (loop x))
+
+(define (eq-set-subset? x y)
+  (define (loop x)
+    (cond ((null? x) true)
+         ((memq (car x) y) (loop (cdr x)))
+         (else false)))
+  (loop x))
+
+(define (eqv-set-subset? x y)
+  (define (loop x)
+    (cond ((null? x) true)
+         ((memv (car x) y) (loop (cdr x)))
+         (else false)))
+  (loop x))
+
+(define (eq-set-same-set? x y)
+  (and (eq-set-subset? x y)
+       (eq-set-subset? y x)))
+
+(define (eqv-set-same-set? x y)
+  (and (eqv-set-subset? x y)
+       (eqv-set-subset? y x)))
\ No newline at end of file