set theory works better

parent 447a85c3
...@@ -4,7 +4,8 @@ ...@@ -4,7 +4,8 @@
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-9 gnu)
#:export (<set> set? set-hash set-n #:export (<set> set? set-hash set-n
make-set-from-assoc make-set-from-assoc-mac set-size)) make-set-from-assoc make-set-from-assoc-mac set-size
set-hash))
#| #|
This takes an assoc like library and transforms it to an ordered/undordered This takes an assoc like library and transforms it to an ordered/undordered
...@@ -132,13 +133,12 @@ Output: set operations and iteratables ...@@ -132,13 +133,12 @@ Output: set operations and iteratables
(define-tool make-set-from-assoc make-set-from-assoc-mac (define-tool make-set-from-assoc make-set-from-assoc-mac
(null assoc acons delete hash mk-kv kv? kv-key kv-val sizefkn (null assoc acons delete hash mk-kv kv? kv-key kv-val sizefkn
value? order? equal? ar->l l->ar) value? order? equal? ar->l l->ar)
(define (make-set '() null 0 0 (list set->kvlist))) (define (make-set '() null 0 0 (list set->kvlist)))
(define size 10000000000000) (define size (@@ (ice-9 set vhashx) *size*))
(define (l-serie app) (define (l-serie app)
(define mt null) (define mt null)
(let lp ((app app)) (let lp ((app app))
...@@ -163,6 +163,7 @@ Output: set operations and iteratables ...@@ -163,6 +163,7 @@ Output: set operations and iteratables
(if (set? x) (if (set? x)
x x
(let ((kv (mk-kv x))) (let ((kv (mk-kv x)))
(hash kv size)
(make-set (l->ar (list kv)) (acons kv null) 1 (hash kv size) (make-set (l->ar (list kv)) (acons kv null) 1 (hash kv size)
(list set->kvlist))))) (list set->kvlist)))))
...@@ -240,6 +241,44 @@ Output: set operations and iteratables ...@@ -240,6 +241,44 @@ Output: set operations and iteratables
#f) #f)
#f)))) #f))))
(define (4 x1 x2 y1 y2)
(match (list (make-one x1)
(make-one x2)
(make-one y1)
(make-one y2))
((($ <set> lx1 mx1 nx1 hx1)
($ <set> lx2 mx2 nx2 hx2)
($ <set> ly1 my1 ny1 hy1)
($ <set> ly2 my2 ny2 hy2))
(if (= (logxor hx1 hx2) (logxor hy1 hy2))
(if (= (+ nx1 nx2) (+ ny1 ny2))
(let ()
(define (try lx1 mx1)
(let lp ((lx1 (l-serie lx1)))
(if (pair? lx1)
(let ((kv (car lx1)))
(if kv
(let ((kvx (assoc kv mx1)))
(if kvx
(let ((kvy1 (assoc kv my1)))
(if kvy1
(if (equal? kvx kvy1)
(lp (cdr lx1))
#f)
(let ((kvy2 (assoc kv my2)))
(if kvy2
(if (equal? kvx kvy2)
(lp (cdr lx1))
#f)
#f))))
(lp (cdr lx1))))
(lp (cdr lx1))))
#t)))
(and (try lx1 mx1)
(try lx2 mx2)))
#f)
#f))))
(define (o x y) (define (o x y)
(match (list (make-one x) (make-one y)) (match (list (make-one x) (make-one y))
((($ <set> lx mx nx hx) ($ <set> ly my ny hy)) ((($ <set> lx mx nx hx) ($ <set> ly my ny hy))
...@@ -302,6 +341,84 @@ Output: set operations and iteratables ...@@ -302,6 +341,84 @@ Output: set operations and iteratables
#f) #f)
#f))))) #f)))))
(define (o4 x1 x2 y1 y2)
(match (list (make-one x1) (make-one x2) (make-one y1) (make-one y2))
((($ <set> lx1 mx1 nx1 hx1)
($ <set> lx2 mx2 nx2 hx2)
($ <set> ly1 my1 ny1 hy1)
($ <set> ly2 my2 ny2 hy2))
(let ()
(define (do-the-iteration)
(define (assocx kv)
(let ((kvx (assoc kv mx1)))
(if kvx
kvx
(assoc kv mx2))))
(define (assocy kv)
(let ((kvx (assoc kv my1)))
(if kvx
kvx
(assoc kv my2))))
(let lp ((lx (l-serie (make-append lx1 lx2)))
(ly (l-serie (make-append ly1 ly2))))
(if (pair? lx)
(let ((kvx (car lx)))
(if kvx
(begin
(let ((kvxx (assocx kvx)))
(if kvxx
(if (order? kvxx)
(set! kvx kvxx)
(let ((kvy (assocy kvxx)))
(if kvy
(if (order? kvy)
(set! kvx kvxx)
(lp (cdr lx) ly))
#f)))
(lp (cdr lx) ly)))
(let lp2 ((ly ly))
(if (pair? ly)
(let ((kvy (car ly)))
(begin
(let ((kvyy (assocy kvy)))
(if kvyy
(if (order? kvyy)
(set! kvy kvyy)
(let ((kvxx
(assocx kvyy)))
(if kvxx
(if (equal? kvxx
kvx)
(lp (cdr lx) (cdr ly))
(if (order? kvxx)
#f
(lp2 (cdr ly))))
#f)))
(lp2 (cdr ly))))
(if (equal? kvx kvy)
(lp (cdr lx) (cdr ly))
#f)))
#f)))
(lp (cdr lx) ly)))
(let lp2 ((ly ly))
(if (pair? ly)
(let ((ky (assocy (car ly))))
(if ky
#f
(lp2 (cdr ly))))
#t)))))
(if (= (logxor hx1 hx2) (logxor hy1 hy2))
(if (= (+ nx1 nx2) (+ ny1 ny2))
(do-the-iteration)
#f)
#f)))))
(define (next-mute lp ll l m n h) (define (next-mute lp ll l m n h)
(lp (cdr ll) l m n h)) (lp (cdr ll) l m n h))
...@@ -313,8 +430,9 @@ Output: set operations and iteratables ...@@ -313,8 +430,9 @@ Output: set operations and iteratables
(lp (cdr ll) (cons kv l) m n h)) (lp (cdr ll) (cons kv l) m n h))
(define (next-add-kv lp ll l m n h kv kv*) (define (next-add-kv lp ll l m n h kv kv*)
(lp (cdr ll) (cons kv* l) (acons kv* m) (lp (cdr ll) (cons kv* l) (acons kv* m)
(+ n 1) (logxor h (hash kv* size)))) (+ n 1) (begin (hash kv* size)
(logxor h (hash kv* size)))))
(define (next-add-l lp ll l m n h kv*) (define (next-add-l lp ll l m n h kv*)
(lp (cdr ll) (cons kv* l) m n h)) (lp (cdr ll) (cons kv* l) m n h))
...@@ -619,8 +737,10 @@ Output: set operations and iteratables ...@@ -619,8 +737,10 @@ Output: set operations and iteratables
r))) r)))
(values #:member member (values #:member member
#:= #:u u #:n n #:- s- #:+ s+ #:< #:<= #:= #:=4 4
#:o= o #:ou ou #:on on #:o- o- #:o+ o+ #:o< o #:o<= o #:u u #:n n #:- s- #:+ s+ #:< #:<=
#:o= o #:o=4 o4
#:ou ou #:on on #:o- o- #:o+ o+ #:o< o #:o<= o
#:n- tripple #:n- tripple
#:in in #:fold fold #:map map #:for-each for-each #:empty #:in in #:fold fold #:map map #:for-each for-each #:empty
#:set->list set->list #:set->assoc set->assoc #:set->list set->list #:set->assoc set->assoc
......
...@@ -30,6 +30,8 @@ ...@@ -30,6 +30,8 @@
#:export (vhashx-null vhashx? vhashx-length vhashx-cons vhashx-assoc)) #:export (vhashx-null vhashx? vhashx-length vhashx-cons vhashx-assoc))
(define *size* 100000000000000000)
;;; Author: Ludovic Courtès <ludo@gnu.org> ;;; Author: Ludovic Courtès <ludo@gnu.org>
;;; ;;;
;;; Commentary: ;;; Commentary:
......
...@@ -256,7 +256,8 @@ ...@@ -256,7 +256,8 @@
(if (eq? ch #\.) (if (eq? ch #\.)
(lp #f ch (cons #\. r) #t) (lp #f ch (cons #\. r) #t)
(lp #f ch (cons #\. r) #f)) (lp #f ch (cons #\. r) #f))
(list->string (reverse (cons #\. r)))))))) (list->string ((@ (guile) reverse)
(cons #\. r))))))))
(#\, (#\,
(read-char) (read-char)
......
...@@ -18,20 +18,30 @@ ...@@ -18,20 +18,30 @@
mk-prolog-biop mk-prolog-biop
-> ->
s a)) s a))
#:export #:export
( (
set_to_list set_to_kvlist to_set set_to_list set_to_kvlist to_set
list_to_set
mapset
complex_set_p complex_set_p
advanced-set-printer)) advanced-set-printer))
(define vsetx-empty)
(<define> (ele0 x) (<define> (ele0 x)
(<<match>> (#:mode -) ((<lookup> x)) (<<match>> (#:mode -) ((<lookup> x))
(#(("op2-" k v)) (#(("op2-" k v))
(<cc> (vosetx-union S (mk-kvx (<scm> k) (<lookup> v))) (<and>
vsetx-empty)) (<values> (kk) (ele k))
(<values> (vv) (ele v))
(<cc> (vosetx-union S (mk-kvx (<scm> kk) (<lookup> vv)))
vsetx-empty)))
(x (x
(<cc> vsetx-empty (<and>
(vosetx-union S (mk-kx (<scm> x))))))) (<values> (xx) (ele x))
(<cc> vsetx-empty
(vosetx-union S (mk-kx (<scm> xx))))))))
(<define> (ele1 x) (<define> (ele1 x)
(<<match>> (#:mode -) ((<lookup> x)) (<<match>> (#:mode -) ((<lookup> x))
...@@ -50,7 +60,11 @@ ...@@ -50,7 +60,11 @@
(#(#:brace v) (#(#:brace v)
(<and> (<and>
(<values> (a c) (ele1 v)) (<values> (a c) (ele1 v))
(<cc> (make-set- a vsetx-empty c #f #f)))) (cond
((eq? a vsetx-empty)
(<cc> c))
(else
(<cc> (make-set- a vsetx-empty (vosetx-difference S c a) #f #f))))))
(x (<cc> x)))) (x (<cc> x))))
...@@ -64,12 +78,21 @@ ...@@ -64,12 +78,21 @@
(<values> (x) (ele x)) (<values> (x) (ele x))
(<ret> (f S x))) (<ret> (f S x)))
(set! (@@ (logic guile-log prolog goal-functors) scm-brace-eval) (define (fail) #f)
(lambda (s x) (define (cc s p x) x)
(ele s (eval-when (compile eval load)
(lambda () #f) (begin
(lambda (s p x) x) (set! (@@ (logic guile-log prolog goal-functors) scm-brace-eval)
x))) (lambda (s x)
(ele s
(lambda () #f)
(lambda (s p x) x)
x)))
(set! (@@ (logic guile-log prolog goal) brace-stx-scm)
(lambda (stx x)
#`(ele S fail cc
`#,((@@ (logic guile-log prolog var) arg) stx x))))))
(define (make2 s f x y) (define (make2 s f x y)
(make-2 s (lambda () #f) (lambda x #t) f x y)) (make-2 s (lambda () #f) (lambda x #t) f x y))
...@@ -79,7 +102,9 @@ ...@@ -79,7 +102,9 @@
(define-syntax-rule (mk2 nm1 nm2) (define-syntax-rule (mk2 nm1 nm2)
(define-syntax-rule (nm1 x y) (define-syntax-rule (nm1 x y)
(make2 S nm2 (gp-lookup x S) (gp-lookup y S)))) (make2 S nm2
(gp-lookup x S)
(gp-lookup y S))))
(define complex_set_p (make-fluid #t)) (define complex_set_p (make-fluid #t))
(<wrap> add-fluid-dynamics complex_set_p) (<wrap> add-fluid-dynamics complex_set_p)
...@@ -96,10 +121,11 @@ ...@@ -96,10 +121,11 @@
(mk2 set_difference_ (wrap vsetx-difference vosetx-difference )) (mk2 set_difference_ (wrap vsetx-difference vosetx-difference ))
(mk2 set_intersection_ (wrap vsetx-intersection vosetx-intersection )) (mk2 set_intersection_ (wrap vsetx-intersection vosetx-intersection ))
(mk-scheme-biop 'yfx "∪" tr- set_union_ s s) (eval-when (compile load eval)
(mk-scheme-biop 'yfx "⊕" tr- set_addition_ s s) (mk-scheme-biop 'yfx "∪" tr- set_union_ s s)
(mk-scheme-biop 'yfx "∖" tr- set_difference_ s s) (mk-scheme-biop 'yfx "⊕" tr- set_addition_ s s)
(mk-scheme-biop 'yfx "∩" tr- set_intersection_ s s) (mk-scheme-biop 'yfx "∖" tr- set_difference_ s s)
(mk-scheme-biop 'yfx "∩" tr- set_intersection_ s s))
(define-syntax-rule (mk1 nm1 nm2) (define-syntax-rule (mk1 nm1 nm2)
(define-syntax-rule (nm1 x) (make1 S nm2 (gp-lookup x S)))) (define-syntax-rule (nm1 x) (make1 S nm2 (gp-lookup x S))))
...@@ -111,7 +137,7 @@ ...@@ -111,7 +137,7 @@
(<define> (memb x y) (when (make2 S vsetx-in (<define> (memb x y) (when (make2 S vsetx-in
(<lookup> x) (<lookup> y)))) (<lookup> x) (<lookup> y))))
(<define> (equiv x y) (when (make2 S (wrap vsetx-equal? vosetx-equal?) (<define> (equiv x y) (when (make2 S vsetx-equal?
(<lookup> x) (<lookup> y)))) (<lookup> x) (<lookup> y))))
(<define> (subset x y) (when (make2 S (wrap vsetx-subset< vosetx-subset<) (<define> (subset x y) (when (make2 S (wrap vsetx-subset< vosetx-subset<)
(<lookup> x) (<lookup> y)))) (<lookup> x) (<lookup> y))))
...@@ -122,12 +148,15 @@ ...@@ -122,12 +148,15 @@
(define (mq x) (define (mq x)
(define (u x)
(if (equal? x '(nonvalue))
#f
x))
(if (pair? x) (if (pair? x)
(if (equal? (cdr x) '(nonvalue)) (cons (car x) (u (cdr x)))
(cons (car x) #f)
x)
(if x (if x
(cons (get-k x) (get-v x)) (cons (get-k x) (u (get-v x)))
x))) x)))
...@@ -162,7 +191,7 @@ ...@@ -162,7 +191,7 @@
(mk-prolog-biop 'xfx "⊇" tr- supseteq s s) (mk-prolog-biop 'xfx "⊇" tr- supseteq s s)
(mk-prolog-biop 'xfx "⊃" tr- supset s s) (mk-prolog-biop 'xfx "⊃" tr- supset s s)
(mk-prolog-biop 'xfx "≡" tr- equiv s s) (mk-prolog-biop 'xfx "≡" tr- equiv s s)
(mk-prolog-biop 'xfx "∈" tr- member a a) (mk-prolog-biop 'xfx "∈" tr- member a s)
(mk-prolog-biop 'xfx "≡" tr- equiv s s) (mk-prolog-biop 'xfx "≡" tr- equiv s s)
...@@ -178,3 +207,28 @@ ...@@ -178,3 +207,28 @@
(<define> (to_set x y) (<=> y ,(make1 S ->vsetx (<lookup> x)))) (<define> (to_set x y) (<=> y ,(make1 S ->vsetx (<lookup> x))))
(<define> (rev l ll) (<=> ll ,(reverse (<scm> l))))
(compile-prolog-string
"
f(X,Y) :- Y is X + X.
list_to_set(L,S) :-
rev(L,LL),
list_to_set(LL,∅,S).
list_to_set([],S,S).
list_to_set([X|L],S,SS) :-
(
(\\+var(X), X = K-V) ->
S2 is {K-V} ∪ S;
S2 is {X} ∪ S
),
list_to_set(L,S2,SS).
mapset(S,Map,SS) :-
findall(V, (_-V ∈ (Map ∩ S), V \\= #f),L),
list_to_set(L,SS).
")
...@@ -206,7 +206,7 @@ ...@@ -206,7 +206,7 @@
quoted ignore_ops numbervars write_option quoted ignore_ops numbervars write_option
;; replacings ;; replacings
append length open close member append length open close member
;; Error functions ;; Error functions
error type_error instantiation_error domain_error error type_error instantiation_error domain_error
......
...@@ -136,6 +136,10 @@ ...@@ -136,6 +136,10 @@
((x) (goal stx x)))) ((x) (goal stx x))))
(define (brace-stx-scm . l)
(warn "X is {...}, is not supported as compilation target")
#f)
;;We do not, use eval-scm to eval objects in scm contexts ;;We do not, use eval-scm to eval objects in scm contexts
(define (scm stx x) (define (scm stx x)
(define (sarg stx x) #``#,(arg stx x)) (define (sarg stx x) #``#,(arg stx x))
...@@ -153,6 +157,9 @@ ...@@ -153,6 +157,9 @@
((#:group x) ((#:group x)
(scm stx x)) (scm stx x))
((#:lam-term #f l _ _ _)
(brace-stx-scm stx x))
((#:scm-term (#:atom s . _) l _ _) ((#:scm-term (#:atom s . _) l _ _)
(mk-scheme stx s l #t)) (mk-scheme stx s l #t))
......
...@@ -205,7 +205,7 @@ ...@@ -205,7 +205,7 @@
)) ))
(xfy 400 :) (xfy 400 :)
,@(map (lambda (x) `(yfx 500 ,x)) '(+ - "/\\" "\\/" xor)) ,@(map (lambda (x) `(yfx 500 ,x)) '(+ - "/\\" "\\/" xor))
,@(map (lambda (x) `(yfx 400 ,x)) '( * / // rdiv << >> mod rem)) ,@(map (lambda (x) `(yfx 400 ,x)) '( * / // rdiv << >> mod rem))
(xfx 200 **) (xfx 200 **)
(xfy 200 ^) (xfy 200 ^)
(xf 200 ) (xf 200 )
...@@ -237,9 +237,9 @@ ...@@ -237,9 +237,9 @@
=:= =< == "=\\=" > >= @< @=< @> @>= "\\=" "\\==" as is =:= =< == "=\\=" > >= @< @=< @> @>= "\\=" "\\==" as is
)) ))
(xfy 600 :) (xfy 600 :)
,@(map (lambda (x) `(yfx 500 ,x)) '(+ - "/\\" "\\/" xor)) ,@(map (lambda (x) `(yfx 500 ,x)) '(+ - "/\\" "\\/" xor))
(fx 500 ?) (fx 500 ?)
,@(map (lambda (x) `(yfx 400 ,x)) '(* / // div rdiv << >> mod rem)) ,@(map (lambda (x) `(yfx 400 ,x)) '(* / // div rdiv << >> mod rem))
(xfx 200 **) (xfx 200 **)
(xfy 200 ^) (xfy 200 ^)
,@(map (lambda (x) `(fy 200 ,x)) '(- + "\\")) ,@(map (lambda (x) `(fy 200 ,x)) '(- + "\\"))
...@@ -703,9 +703,7 @@ ...@@ -703,9 +703,7 @@
(<p-lambda> (c) (<p-lambda> (c)
(.. (c0) (ws c)) (.. (c0) (ws c))
(<let> ((n N) (m M)) (<let> ((n N) (m M))
(xx (c1) (.. (c1) (atom c0))
(<or> (.. (atom c0))
(<p-cc> #f)))
(.. (c2) (l c1)) (.. (c2) (l c1))
(xx (cl) (<or> (xx (cl) (<or>
(<and> (<and>
...@@ -731,6 +729,30 @@ ...@@ -731,6 +729,30 @@
`(#:lam-term ,c1 ,(<scm> c3) ,cl ,n ,m)))))) `(#:lam-term ,c1 ,(<scm> c3) ,cl ,n ,m))))))
mk-id))) mk-id)))
(define set-tok
(let* ((l (f-tag "{"))
(r (f-tag "}"))
(l! (f-tag! "{"))
(r! (f-tag! "}"))
(e (letrec ((body (lambda (n)
(f*
(f-or
ws+
(f-seq l! (Ds (body (+ n 1))) r!)
(f-not! (f-or l r)))))))
(mk-token (body 0)))))
(p-freeze 'set-tok
(<p-lambda> (c)
(.. (c0) (ws c))
(<let> ((n N) (m M))
(.. (c2) (l c0))
(.. (c3) (expr c2))
(.. (c4) (r c3))
(<p-cc>
`(#:lam-term #f ,(<scm> c3) #f ,n ,m))))
mk-id)))
(define true/false (define true/false
(let ((tag (mk-token (f-seq (f-or (f-tag! "#t") (f-tag! "#f")) (let ((tag (mk-token (f-seq (f-or (f-tag! "#t") (f-tag! "#f"))
(f-not* rest-var))))) (f-not* rest-var)))))
...@@ -868,6 +890,7 @@ ...@@ -868,6 +890,7 @@
char list-tok true/false char list-tok true/false
termvar-tok #;term-binop-tok #;termop-tok termvar-tok #;term-binop-tok #;termop-tok
termstring-tok term-tok term-unop scm-tok lam-tok termstring-tok term-tok term-unop scm-tok lam-tok
set-tok
number qstring dstring atom variable symsym number qstring dstring atom variable symsym
#;op-tok)) #;op-tok))
......
...@@ -118,6 +118,8 @@ ...@@ -118,6 +118,8 @@
mxequal?)) mxequal?))
(define <<set>> (@ (ice-9 set complement) <set>))
(define-inlinable (id x) x) (define-inlinable (id x) x)
(define-record-type <kv> (define-record-type <kv>
(mk-kv k v) (mk-kv k v)
...@@ -133,13 +135,13 @@ ...@@ -133,13 +135,13 @@
(define-syntax-rule (mk-set . l) (define-syntax-rule (mk-set . l)
(call-with-values (lambda () (make-set-from-assoc . l)) (call-with-values (lambda () (make-set-from-assoc . l))
(lambda* (#:key member (lambda* (#:key member
n- = u n - + < <= n- = =4 u n - + < <=
o= ou on o- o+ o< o<= o= o=4 ou on o- o+ o< o<=
in fold map for-each empty set->list set->assoc set->kvlist in fold map for-each empty set->list set->assoc set->kvlist
make-one) make-one)
(call-with-values (lambda () (call-with-values (lambda ()
(make-complementable-set (make-complementable-set
member empty u n - n- = set-size set? make-one)) member empty u n - n- = =4 set-size set? make-one))
(lambda* (#:key world u n c + - = < <= ->set memb #:allow-other-keys ) (lambda* (#:key world u n c + - = < <= ->set memb #:allow-other-keys )
(define c< < ) (define c< < )
(define c<= <=) (define c<= <=)
...@@ -148,7 +150,8 @@ ...@@ -148,7 +150,8 @@
(call-with-values (lambda () (call-with-values (lambda ()
(make-complementable-set (make-complementable-set
member member
empty ou on o- n- o= set-size set? make-one)) empty ou on o- n- o= o=4
set-size set? make-one))
(lambda* (#:key ou on oc o+ o- = < <= #:allow-other-keys ) (lambda* (#:key ou on oc o+ o- = < <= #:allow-other-keys )
(define o< < ) (define o< < )
(define o<= <=) (define o<= <=)
...@@ -324,26 +327,32 @@ ...@@ -324,26 +327,32 @@
(define sfluid (make-fluid #f)) (define sfluid (make-fluid #f))
(define (xhash x size) (define (xhash x size)
(let* ((s (fluid-ref sfluid))) (let lp ((x x))
(let lp ((x x)) (umatch (#:mode -) (x)
(let ((x (gp-lookup x s))) (#(x)
(umatch (#:mode -) (x) (lp x))
(#(x)
(lp x)) ((x . l)
(logxor (lp x) (lp l)))
((x . l)
(logxor (lp x) (lp l))) (_
(cond
(_ ((set? x)
(cond (modulo (set-hash x) size))
((set? x) ((cset? x)
(modulo (set-hash x) size)) (match x
(else (($ <<set>> a b c p)
(hash x size))))))))) (if p
(modulo (set-hash c) size)
(modulo (logxor (set-hash a) (set-hash c))
size)))))
(else
(hash x size)))))))
(define (xequal?- x y) (define (xequal?- x y)
(if (and (set? x) (set? y)) (if (and (or (set? x) (cset? x)) (or (set? x) (cset? y)))
(vsetx-equal? x y) (let ((s (fluid-ref sfluid)))
(vsetx-equal? s x y))
(equal? x y))) (equal? x y)))
(define (xequal? x y z w) (xequal?- x y)) (define (xequal? x y z w) (xequal?- x y))
...@@ -353,7 +362,7 @@ ...@@ -353,7 +362,7 @@
(let ((x (gp-lookup s x)) (let ((x (gp-lookup s x))
(y (gp-lookup s y)))