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
From 4ad20e760c4745ea27bc83a21d12a8ef84c87445 Mon Sep 17 00:00:00 2001
From: Taylan Kammer <taylan.kam...@gmail.com>
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
