Subject: bug#48425: Should #nil be equal? to '()?

From: Taylan Kammer <[email-masked]>
Date: Fri, 14 May 2021 21:36:39 +0200

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 <[email-masked]>
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