bug#48425: Should #nil be equal? to '()?
Taylan Kammer <[email protected]>
| Newsgroups | gmane.lisp.guile.bugs |
|---|---|
| Message-ID | <[email protected]> |
I believe it would be better if #nil were equal? to (). It would keep *not* being equal? to #f and as such not disturb the property of transitiveness. Making #nil and () be equal? would be a lot more intuitive since they both represent the empty list, and since equal? is commonly used to test the equality of lists. Meeting this expectation would probably prevent a common type of unexpected behavior where a list coming from Elisp code is not equal? to a list coming from Scheme code, even though they have the same contents. Attached is a patch to realize the change. Note that it increases the size of compiled code that uses equal?. I don't know if this represents a problem or not. Before patch: scheme@(guile-user)> ,disassemble (lambda (x y) (equal? x y)) Disassembly of #<procedure 55dd585a0c58 at <unknown port>:1:13 (x y)> at #x55dd585a0ad4: 0 (instrument-entry 131) at (unknown file):1:13 2 (assert-nargs-ee/locals 3 0) ;; 3 slots (2 args) 3 (eq? 1 0) at (unknown file):1:27 4 (je 29) ;; -> L4 5 (immediate-tag=? 1 7 0) ;; heap-object? 7 (jne 22) ;; -> L3 8 (immediate-tag=? 0 7 0) ;; heap-object? 10 (jne 15) ;; -> L2 11 (static-ref 2 96) ;; #f 13 (immediate-tag=? 2 7 0) ;; heap-object? 15 (je 7) ;; -> L1 16 (call-scm<-scmn-scmn 2 103 107 113) 20 (static-set! 2 87) ;; #f L1: 22 (scm-ref/immediate 2 2 1) 23 (handle-interrupts) 24 (tail-call) L2: 25 (make-immediate 2 4) ;; #f 26 (reset-frame 1) ;; 1 slot 27 (handle-interrupts) 28 (return-values) L3: 29 (make-immediate 2 4) ;; #f 30 (reset-frame 1) ;; 1 slot 31 (handle-interrupts) 32 (return-values) L4: 33 (make-immediate 2 1028) ;; #t 34 (reset-frame 1) ;; 1 slot 35 (handle-interrupts) 36 (return-values) After patch: scheme@(guile-user)> ,disassemble (lambda (x y) (equal? x y)) Disassembly of #<procedure 55b741d3ad50 at <unknown port>:8:13 (x y)> at #x55b741d3ab94: 0 (instrument-entry 145) at (unknown file):8:13 2 (assert-nargs-ee/locals 3 0) ;; 3 slots (2 args) 3 (eq? 1 0) at (unknown file):8:27 4 (je 43) ;; -> L6 5 (immediate-tag=? 1 3583 260) ;; null? 7 (jne 12) ;; -> L2 8 (immediate-tag=? 0 3583 260) ;; null? 10 (je 5) ;; -> L1 11 (make-immediate 2 4) ;; #f 12 (reset-frame 1) ;; 1 slot 13 (handle-interrupts) 14 (return-values) L1: 15 (make-immediate 2 1028) ;; #t 16 (reset-frame 1) ;; 1 slot 17 (handle-interrupts) 18 (return-values) L2: 19 (immediate-tag=? 1 7 0) ;; heap-object? 21 (jne 22) ;; -> L5 22 (immediate-tag=? 0 7 0) ;; heap-object? 24 (jne 15) ;; -> L4 25 (static-ref 2 96) ;; #f 27 (immediate-tag=? 2 7 0) ;; heap-object? 29 (je 7) ;; -> L3 30 (call-scm<-scmn-scmn 2 103 107 113) 34 (static-set! 2 87) ;; #f L3: 36 (scm-ref/immediate 2 2 1) 37 (handle-interrupts) 38 (tail-call) L4: 39 (make-immediate 2 4) ;; #f 40 (reset-frame 1) ;; 1 slot 41 (handle-interrupts) 42 (return-values) L5: 43 (make-immediate 2 4) ;; #f 44 (reset-frame 1) ;; 1 slot 45 (handle-interrupts) 46 (return-values) L6: 47 (make-immediate 2 1028) ;; #t 48 (reset-frame 1) ;; 1 slot 49 (handle-interrupts) 50 (return-values) - Taylan
0001-Make-nil-and-equal-as-per-equal.patch
(text/plain, 4.4 KB)
From 4ad20e760c4745ea27bc83a21d12a8ef84c87445 Mon Sep 17 00:00:00 2001 From: Taylan Kammer <[email protected]> Date: Fri, 14 May 2021 18:35:12 +0200 Subject: [PATCH] Make #nil and () equal as per equal?. * libguile/eq.c (scm_equal_p): Add check to see if both arguments satisfy null? and return true if they do. * module/language/tree-il/compile-cps.scm (canonicalize): In equal? primcalls, add a check to see if both arguments satisfy null?. * module/language/tree-il/peval.scm (peval): In the partial evaluation of equality primitives, don't fold to eq? for #nil and '(). --- libguile/eq.c | 3 ++ module/language/tree-il/compile-cps.scm | 39 ++++++++++++++++--------- module/language/tree-il/peval.scm | 4 +-- 3 files changed, 30 insertions(+), 16 deletions(-) diff --git a/libguile/eq.c b/libguile/eq.c index 627d6f09b..0a8a60634 100644 --- a/libguile/eq.c +++ b/libguile/eq.c @@ -299,6 +299,9 @@ scm_equal_p (SCM x, SCM y) SCM_TICK; if (scm_is_eq (x, y)) return SCM_BOOL_T; + /* Make sure #nil and () are equal. */ + if (scm_is_null (x) && scm_is_null (y)) + return SCM_BOOL_T; if (SCM_IMP (x)) return SCM_BOOL_F; if (SCM_IMP (y)) diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index ffc8308a6..a0a3e2381 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -2478,14 +2478,15 @@ integer." (let () (define-syntax-rule (primcall name . args) (make-primcall src 'name (list . args))) - (define-syntax primcall-chain + (define-syntax primcall-cond-chain (syntax-rules () - ((_ x) x) - ((_ x . y) - (make-conditional src (primcall . x) (primcall-chain . y) - (make-const src #f))))) - (define-syntax-rule (bool x) - (make-conditional src x (make-const src #t) (make-const src #f))) + ((_ consequent alternate) consequent) + ((_ test test* ... consequent alternate) + (make-conditional + src + (primcall . test) + (primcall-cond-chain test* ... consequent alternate) + alternate)))) (with-lexicals src (a b) (make-conditional src @@ -2494,14 +2495,24 @@ integer." (match (primcall-name exp) ('eqv? ;; Completely inline. - (primcall-chain (heap-number? a) - (heap-number? b) - (bool (primcall heap-numbers-equal? a b)))) + (primcall-cond-chain + (heap-number? a) + (heap-number? b) + (heap-numbers-equal? a b) + (make-const src #t) + (make-const src #f))) ('equal? - ;; Partially inline. - (primcall-chain (heap-object? a) - (heap-object? b) - (primcall equal? a b)))))))) + ;; Make sure #nil and () are equal. + (primcall-cond-chain + (null? a) + (null? b) + (make-const src #t) + ;; Partially inline. + (primcall-cond-chain + (heap-object? a) + (heap-object? b) + (primcall equal? a b) + (make-const src #f))))))))) (($ <primcall> src 'vector args) ;; Expand to "allocate-vector" + "vector-init!". diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index d910088c9..93741b4cf 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -1430,8 +1430,8 @@ top-level bindings from ENV and return the resulting expression." ((eq? name 'eq?) ;; Already in a reduced state. (make-primcall src 'eq? (list a b))) - ((or (memq v '(#f #t () #nil)) (symbol? v) (char? v) - ;; Only fold to eq? value is a fixnum on target and + ((or (memq v '(#f #t)) (symbol? v) (char? v) + ;; Only fold to eq? if value is a fixnum on target and ;; host, as constant folding may have us compare on host ;; as well. (and (exact-integer? v) -- 2.30.2