equal? works on sets

parent db1170ec
(define-module (ice-9 set complement) (define-module (ice-9 set complement)
#:use-module (oop goops)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 set set) #:use-module (ice-9 set set)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
...@@ -91,6 +92,7 @@ using that predicate ...@@ -91,6 +92,7 @@ using that predicate
(define advanced-set-printer #t) (define advanced-set-printer #t)
#;
(define-record-type <set> (define-record-type <set>
(make-set- map map-complement set set-complement? meta) (make-set- map map-complement set set-complement? meta)
cset? cset?
...@@ -100,7 +102,26 @@ using that predicate ...@@ -100,7 +102,26 @@ using that predicate
(set-complement? set-complement?) (set-complement? set-complement?)
(meta set-meta)) (meta set-meta))
(set-record-type-printer! <set> (define-class <set> ()
(map #:getter set-map
#:init-keyword #:map)
(map-complement #:getter set-map-complement
#:init-keyword #:map-complement)
(set #:getter set-set
#:init-keyword #:set)
(set-complement? #:getter set-complement?
#:init-keyword #:complement?)
(meta #:getter set-meta
#:init-keyword #:meta))
(define (make-set- map map-complement set set-complement? meta)
(make <set> #:map map #:map-complement map-complement #:set set
#:complement? set-complement? #:meta meta))
(define (cset? x)
(eq? (class-of x) <set>))
(define (set-printer vl port)
(lambda (vl port) (lambda (vl port)
(let ((c (set-set vl)) (let ((c (set-set vl))
(a (set-map vl)) (a (set-map vl))
...@@ -117,6 +138,18 @@ using that predicate ...@@ -117,6 +138,18 @@ using that predicate
(format port "(~a∖~a ∪ ~aᶜ)" a b c) (format port "(~a∖~a ∪ ~aᶜ)" a b c)
(format port "(~a∖~a ∪ ~a)" a b c))))))) (format port "(~a∖~a ∪ ~a)" a b c)))))))
(define *equal?* (make-fluid (lambda (x y) (eq? x y))))
(define-method (equal? (x <set>) (y <set>))
((fluid-ref *equal?*) x y))
(define-method (write (x <set>) port)
(set-printer x port))
#;
(set-record-type-printer! <set> set-printer)
(set-object-property! <set> 'prolog-printer (set-object-property! <set> 'prolog-printer
(lambda (lp vl advanced?) (lambda (lp vl advanced?)
(if advanced-set-printer (set! advanced? #t)) (if advanced-set-printer (set! advanced? #t))
......
...@@ -29,6 +29,10 @@ ...@@ -29,6 +29,10 @@
(define vsetx-empty) (define vsetx-empty)
(fluid-set! (@@ (ice-9 set complement) *equal?*)
(lambda (x y)
(vsetx-equal? #f x y)))
(<define> (ele0 x) (<define> (ele0 x)
(<<match>> (#:mode -) ((<lookup> x)) (<<match>> (#:mode -) ((<lookup> x))
(#(("op2-" k v)) (#(("op2-" k v))
...@@ -57,15 +61,23 @@ ...@@ -57,15 +61,23 @@
(<define> (ele x) (<define> (ele x)
(<<match>> (#:mode -) ((<lookup> x)) (<<match>> (#:mode -) ((<lookup> x))
(#(#:brace v) (#(#:brace v)
(<and> (<and>
(<values> (a c) (ele1 v)) (<values> (a c) (ele1 v))
(cond (<cc> (make-set- a vsetx-empty (vosetx-difference S c a) #f #f))))
((eq? a vsetx-empty)
(<cc> c)) ((a . b)
(else (<and>
(<cc> (make-set- a vsetx-empty (vosetx-difference S c a) #f #f)))))) (<values> (aa) (ele a))
(x (<cc> x)))) (<values> (bb) (ele a))
(<cc> (cons aa bb))))
(#(l)
(<and>
(<values> (a) (ele l))
(<cc> (vector a))))
(x (<cc> x))))
(<define> (make-2 f x y) (<define> (make-2 f x y)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment