From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 26 Jun 1987 02:22:12 +0000 (+0000)
Subject: Add some operations for new regset abstraction.
X-Git-Tag: 20090517-FFI~13320
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=c8ec3fbdd252ca0b926244fb180995d8e3717646;p=mit-scheme.git

Add some operations for new regset abstraction.
---

diff --git a/v7/src/compiler/base/sets.scm b/v7/src/compiler/base/sets.scm
index 2d3340ff5..7c5497fcf 100644
--- 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))
+
+(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