bug#33036: Bug with the procedure nil? inside a specific code

bug#33036: Bug with the procedure nil? inside a specific code

[calcium]

Order of content:
1] --- Setup information
2] --- what is the procedure nil?
3] --- snippet of code that trigger the bug
4] --- snippet of code that doesn't trigger the bug
5] --- Summary and end

1] ---

Setup :

$ ./config.guess
x86_64-pc-linux-gnu

$ guile --version
guile: warning: failed to install locale
guile (GNU Guile) 2.2.3
etc ...

-> Guile was installed in a foreign Gnu/Linux distribution via Guix.

2] ---

The procedure nil? is not listed in the procedure index :
https://www.gnu.org/software/guile/docs/docs-2.0/guile-ref/Procedure-Index.html

There is a page that speak about nil :
https://www.gnu.org/software/guile/manual/html_node/Nil.html
However it doesn’t mention the nil? Procedure

The only documentation that I found about nil? is this one :

(procedure-documentation nil?)
=> "- Scheme Procedure: nil? x\n     Return `#t' iff X is nil, else
return `#f'."

(procedure-documentation null?)
=> "- Scheme Procedure: null? x\n     Return `#t' iff X is the empty
list, else `#f'."

The procedure documentation is not the same for nil? and null?
They seem nonetheless to be the same.

(null? #nil)
=> #t
(null? ‘())
=> #t

(nil? #nil)
=> #t
(nil? '())
=> #t

3] ---

Here is the bug that I found :

;;; -START- code with the bug -START- ;;;

(define (strange lst)
  (let loop ((lst lst)
             (is-empty '()))
    (cond ((nil? lst)
           (if (nil? is-empty) 'works
             (list 'should-not-occur is-empty)))
          (else
           (loop (cdr lst)
                 is-empty)))))

(strange '())
=> (should-not-occur ())

(strange #nil)
=> (should-not-occur ())

;;; -END- code with the bug -END- ;;;

4] ---

And here follows 3 version that doesn’t trigger this bug.

;;; in this one we remove the call to the loop in the else clause
;;; -START- code that works (1) -START- ;;;

(define (not-strange-1 lst)
  (let loop ((lst lst)
             (is-empty '()))
    (cond ((nil? lst)
           (if (nil? is-empty) 'works
             (list 'should-not-occur is-empty)))
          (else
           'no-more-bug))))

(not-strange-1 '())
=> works
(not-strange-1 #nil)
=> works

;;; -END- code that works (1) -END- ;;;

;;;  we change the ‘() of is-empty to #nil
;;; -START- code that works (2) -START- ;;;

(define (not-strange-2 lst)
  (let loop ((lst lst)
             (is-empty #nil))
    (cond ((nil? lst)
           (if (nil? is-empty) 'works
             (list 'should-not-occur is-empty)))
          (else
           (loop (cdr lst)
                 is-empty)))))

(not-strange-2 '())
=> works
(not-strange-2 #nil)
=> works

;;; -END- code that works (2) -END- ;;;

;;;  if we use null? instead of nil? at the critical point (nil? is-empty)
;;; -START- code that works (3) -START- ;;;

(define (not-strange-3 lst)
  (let loop ((lst lst)
             (is-empty '()))
    (cond ((nil? lst)
           (if (null? is-empty) 'works
             (list 'should-not-occur is-empty)))
          (else
           (loop (cdr lst)
                 is-empty)))))

(not-strange-3 '())
=> works
(not-strange-3 #nil)
=> works

;;; -END- code that works (3) -END- ;;;

5] ---

So in summary :

1) removing the call to the loop in the else clause remove the bug.
This is interesting because we don’t enter the else clause

2) using the #nil instead of ‘() did change the outcome.
But except for this case, it doesn't seem to change the outcome to use
#nil or ‘()

3) using null? Instead of nil? did change the outcome.
This is similar to point 2. except that we change the procedure instead
of the value.


I think that there is 2 way to look at this bug:

The first one is to consider that it is a bug because nil? and null?
should give the same answer.

The second one is to consider that nil? should only answer #t when we
use it with #nil, and otherwise give #f (this include ‘() ).


 ---

If you require any further information or did not understand what I
said, feel free to contact me at calcium@disroot.org

bug#33036: Bug with the procedure nil? inside a specific code

[Mark H Weaver]

Hi,

calcium <calcium@disroot.org> writes:
> The procedure nil? is not listed in the procedure index :
> https://www.gnu.org/software/guile/docs/docs-2.0/guile-ref/Procedure-Index.html

The link above is the manual for Guile 2.0, which didn't have 'nil?'.
It was added in Guile 2.2.

> There is a page that speak about nil :
> https://www.gnu.org/software/guile/manual/html_node/Nil.html
> However it doesn’t mention the nil? Procedure
>
> The only documentation that I found about nil? is this one :
>
> (procedure-documentation nil?)
> => "- Scheme Procedure: nil? x\n     Return `#t' iff X is nil, else
> return `#f'."

I agree that the documentation for 'nil?' is woefully inadequate.  We
should add a manual entry for 'nil?' and improve its docstring.

'nil?' tests whether Emacs Lisp code would consider the value to be nil,
i.e. whether it would be considered false by Elisp 'if' or 'cond'.

Scheme has two distinct values for the empty list () and false #f.  In
Elisp, both of these concepts are represented by the same value: nil.
As a result, the empty list is considered "true" in Scheme, and "false"
in Elisp.

In other words, 'nil?' returns #t if its argument is #f, (), or #nil,
otherwise it returns #f.

> (procedure-documentation null?)
> => "- Scheme Procedure: null? x\n     Return `#t' iff X is the empty
> list, else `#f'."
>
> The procedure documentation is not the same for nil? and null?
> They seem nonetheless to be the same.

No, they differ in their handling of #f:

  (null? #f) => #f
  (nil?  #f) => #t

> Here is the bug that I found :
>
> ;;; -START- code with the bug -START- ;;;
>
> (define (strange lst)
>   (let loop ((lst lst)
>              (is-empty '()))
>     (cond ((nil? lst)
>            (if (nil? is-empty) 'works
>              (list 'should-not-occur is-empty)))
>           (else
>            (loop (cdr lst)
>                  is-empty)))))
>
> (strange '())
> => (should-not-occur ())
>
> (strange #nil)
> => (should-not-occur ())

Indeed, this certainly indicates a bug.

I believe the bug is in 'local-type-fold' in (language cps type-fold).
It contains a local procedure 'scalar-value' which, if I understand
correctly, seems to incorrectly assume that (nil? x) returns #t if and
only if X is 'eq?' to #nil.

To be continued...

Thanks very much for this detailed report!

    Regards,
      Mark

bug#33036: Bug with the procedure nil? inside a specific code

[Mark H Weaver]

[-- Attachment #1: Type: text/plain, Size: 1131 bytes --]

Mark H Weaver <mhw@netris.org> writes:

> calcium <calcium@disroot.org> writes:
>> Here is the bug that I found :
>>
>> ;;; -START- code with the bug -START- ;;;
>>
>> (define (strange lst)
>>   (let loop ((lst lst)
>>              (is-empty '()))
>>     (cond ((nil? lst)
>>            (if (nil? is-empty) 'works
>>              (list 'should-not-occur is-empty)))
>>           (else
>>            (loop (cdr lst)
>>                  is-empty)))))
>>
>> (strange '())
>> => (should-not-occur ())
>>
>> (strange #nil)
>> => (should-not-occur ())
>
> Indeed, this certainly indicates a bug.
>
> I believe the bug is in 'local-type-fold' in (language cps type-fold).
> It contains a local procedure 'scalar-value' which, if I understand
> correctly, seems to incorrectly assume that (nil? x) returns #t if and
> only if X is 'eq?' to #nil.

The bug actually wasn't in 'local-type-fold', but it's true that the
type inferencer assumed in a few places that if (nil? X) returned #t
that X must be #nil, and similarly for 'null?' and ().

I've attached a proposed fix.

Andy, does this fix look right to you?

     Thanks,
       Mark



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: [PATCH] Fix type inferencing for 'nil?' and 'null?' predicates --]
[-- Type: text/x-patch, Size: 5540 bytes --]

From d904d5233582e51a4be06d2c08ccdd15a66b8d77 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Sat, 13 Oct 2018 23:02:05 -0400
Subject: [PATCH] Fix type inferencing for 'nil?' and 'null?' predicates.

Fixes <https://bugs.gnu.org/33036>.
Reported by <calcium@disroot.org>.

* module/language/cps/types.scm (define-simple-type-inferrer):
Apply (logand (&type val) <>) uniformly.  Previously, this was done only
in the false branch.  Rename local variable to 'type*', to allow the
macro operand 'type' to be an arbitrary expression.
(*type-inferrers*)<null?>: Add &nil to the set of possible types.
(*type-inferrers*)<nil?>: Add &false and &null to the set the possible
types.
* module/language/cps/type-fold.scm (*branch-folders*)<null?>: Add &nil
to the set of possible types.
(*branch-folders*)<nil?>: Add &false and &null to the set the possible
types.
* test-suite/tests/compiler.test: Add tests.
---
 module/language/cps/type-fold.scm |  6 ++--
 module/language/cps/types.scm     | 13 ++++----
 test-suite/tests/compiler.test    | 51 ++++++++++++++++++++++++++++++-
 3 files changed, 60 insertions(+), 10 deletions(-)

diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
index fc37fac50..163ef659d 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -1,5 +1,5 @@
 ;;; Abstract constant folding on CPS
-;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015, 2018 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -69,8 +69,8 @@
 
 ;; All the cases that are in compile-bytecode.
 (define-unary-type-predicate-folder pair? &pair)
-(define-unary-type-predicate-folder null? &null)
-(define-unary-type-predicate-folder nil? &nil)
+(define-unary-type-predicate-folder null? (logior &nil &null))
+(define-unary-type-predicate-folder nil? (logior &false &nil &null))
 (define-unary-type-predicate-folder symbol? &symbol)
 (define-unary-type-predicate-folder variable? &box)
 (define-unary-type-predicate-folder vector? &vector)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 5c1d71299..61de971fe 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -529,13 +529,14 @@ minimum, and maximum."
 
 (define-syntax-rule (define-simple-predicate-inferrer predicate type)
   (define-predicate-inferrer (predicate val true?)
-    (let ((type (if true?
-                    type
-                    (logand (&type val) (lognot type)))))
-      (restrict! val type -inf.0 +inf.0))))
+    (let ((type* (logand (&type val)
+                         (if true?
+                             type
+                             (lognot type)))))
+      (restrict! val type* -inf.0 +inf.0))))
 (define-simple-predicate-inferrer pair? &pair)
-(define-simple-predicate-inferrer null? &null)
-(define-simple-predicate-inferrer nil? &nil)
+(define-simple-predicate-inferrer null? (logior &nil &null))
+(define-simple-predicate-inferrer nil? (logior &false &nil &null))
 (define-simple-predicate-inferrer symbol? &symbol)
 (define-simple-predicate-inferrer variable? &box)
 (define-simple-predicate-inferrer vector? &vector)
diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
index 4f644f339..64bb976fa 100644
--- a/test-suite/tests/compiler.test
+++ b/test-suite/tests/compiler.test
@@ -1,5 +1,5 @@
 ;;;; compiler.test --- tests for the compiler      -*- scheme -*-
-;;;; Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 2008-2014, 2018 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -251,3 +251,52 @@
 
   (pass-if-equal "test flonum" 0.0 (test-proc #t))
   (pass-if-equal "test complex" 0.0+0.0i (test-proc #f)))
+
+(with-test-prefix "null? and nil? inference"
+  (pass-if-equal "nil? after null?"
+      '((f . f)  ; 3
+        (f . f)  ; #t
+        (f . t)  ; #f
+        (t . t)  ; #nil
+        (t . t)) ; ()
+    (map (compile '(lambda (x)
+                     (if (null? x)
+                         (cons 't (if (nil? x) 't 'f))
+                         (cons 'f (if (nil? x) 't 'f)))))
+         '(3 #t #f #nil ())))
+
+  (pass-if-equal "nil? after truth test"
+      '((t . f)  ; 3
+        (t . f)  ; #t
+        (f . t)  ; #f
+        (f . t)  ; #nil
+        (t . t)) ; ()
+    (map (compile '(lambda (x)
+                     (if x
+                         (cons 't (if (nil? x) 't 'f))
+                         (cons 'f (if (nil? x) 't 'f)))))
+         '(3 #t #f #nil ())))
+
+  (pass-if-equal "null? after nil?"
+      '((f . f)  ; 3
+        (f . f)  ; #t
+        (t . f)  ; #f
+        (t . t)  ; #nil
+        (t . t)) ; ()
+    (map (compile '(lambda (x)
+                     (if (nil? x)
+                         (cons 't (if (null? x) 't 'f))
+                         (cons 'f (if (null? x) 't 'f)))))
+         '(3 #t #f #nil ())))
+
+  (pass-if-equal "truth test after nil?"
+      '((f . t)  ; 3
+        (f . t)  ; #t
+        (t . f)  ; #f
+        (t . f)  ; #nil
+        (t . t)) ; ()
+    (map (compile '(lambda (x)
+                     (if (nil? x)
+                         (cons 't (if x 't 'f))
+                         (cons 'f (if x 't 'f)))))
+         '(3 #t #f #nil ()))))
-- 
2.19.1

bug#33036: Bug with the procedure nil? inside a specific code

[Mark H Weaver]

Mark H Weaver <mhw@netris.org> writes:

> calcium <calcium@disroot.org> writes:
>> There is a page that speak about nil :
>> https://www.gnu.org/software/guile/manual/html_node/Nil.html
>> However it doesn’t mention the nil? Procedure
>>
>> The only documentation that I found about nil? is this one :
>>
>> (procedure-documentation nil?)
>> => "- Scheme Procedure: nil? x\n     Return `#t' iff X is nil, else
>> return `#f'."
>
> I agree that the documentation for 'nil?' is woefully inadequate.  We
> should add a manual entry for 'nil?' and improve its docstring.

I did this in commit b44f505f1571fc9c42e58982f161a9cfc81fb7f4 on the
'stable-2.2' branch.

https://git.savannah.gnu.org/cgit/guile.git/commit/?h=stable-2.2&id=b44f505f1571fc9c42e58982f161a9cfc81fb7f4

    Thanks,
      Mark

bug#33036: Bug with the procedure nil? inside a specific code

[Andy Wingo]

Hi!

Thank you, Mark!  That looks great.

I note also that this is fixed in master, unless I made another bug.
See type-fold.scm:66-87 and types.scm:574-617.

Cheers!

Andy

On Sun 14 Oct 2018 06:05, Mark H Weaver <mhw@netris.org> writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> calcium <calcium@disroot.org> writes:
>>> Here is the bug that I found :
>>>
>>> ;;; -START- code with the bug -START- ;;;
>>>
>>> (define (strange lst)
>>>   (let loop ((lst lst)
>>>              (is-empty '()))
>>>     (cond ((nil? lst)
>>>            (if (nil? is-empty) 'works
>>>              (list 'should-not-occur is-empty)))
>>>           (else
>>>            (loop (cdr lst)
>>>                  is-empty)))))
>>>
>>> (strange '())
>>> => (should-not-occur ())
>>>
>>> (strange #nil)
>>> => (should-not-occur ())
>>
>> Indeed, this certainly indicates a bug.
>>
>> I believe the bug is in 'local-type-fold' in (language cps type-fold).
>> It contains a local procedure 'scalar-value' which, if I understand
>> correctly, seems to incorrectly assume that (nil? x) returns #t if and
>> only if X is 'eq?' to #nil.
>
> The bug actually wasn't in 'local-type-fold', but it's true that the
> type inferencer assumed in a few places that if (nil? X) returned #t
> that X must be #nil, and similarly for 'null?' and ().
>
> I've attached a proposed fix.
>
> Andy, does this fix look right to you?
>
>      Thanks,
>        Mark
>
>
> From d904d5233582e51a4be06d2c08ccdd15a66b8d77 Mon Sep 17 00:00:00 2001
> From: Mark H Weaver <mhw@netris.org>
> Date: Sat, 13 Oct 2018 23:02:05 -0400
> Subject: [PATCH] Fix type inferencing for 'nil?' and 'null?' predicates.
>
> Fixes <https://bugs.gnu.org/33036>.
> Reported by <calcium@disroot.org>.
>
> * module/language/cps/types.scm (define-simple-type-inferrer):
> Apply (logand (&type val) <>) uniformly.  Previously, this was done only
> in the false branch.  Rename local variable to 'type*', to allow the
> macro operand 'type' to be an arbitrary expression.
> (*type-inferrers*)<null?>: Add &nil to the set of possible types.
> (*type-inferrers*)<nil?>: Add &false and &null to the set the possible
> types.
> * module/language/cps/type-fold.scm (*branch-folders*)<null?>: Add &nil
> to the set of possible types.
> (*branch-folders*)<nil?>: Add &false and &null to the set the possible
> types.
> * test-suite/tests/compiler.test: Add tests.
> ---
>  module/language/cps/type-fold.scm |  6 ++--
>  module/language/cps/types.scm     | 13 ++++----
>  test-suite/tests/compiler.test    | 51 ++++++++++++++++++++++++++++++-
>  3 files changed, 60 insertions(+), 10 deletions(-)
>
> diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
> index fc37fac50..163ef659d 100644
> --- a/module/language/cps/type-fold.scm
> +++ b/module/language/cps/type-fold.scm
> @@ -1,5 +1,5 @@
>  ;;; Abstract constant folding on CPS
> -;;; Copyright (C) 2014, 2015 Free Software Foundation, Inc.
> +;;; Copyright (C) 2014, 2015, 2018 Free Software Foundation, Inc.
>  ;;;
>  ;;; This library is free software: you can redistribute it and/or modify
>  ;;; it under the terms of the GNU Lesser General Public License as
> @@ -69,8 +69,8 @@
>  
>  ;; All the cases that are in compile-bytecode.
>  (define-unary-type-predicate-folder pair? &pair)
> -(define-unary-type-predicate-folder null? &null)
> -(define-unary-type-predicate-folder nil? &nil)
> +(define-unary-type-predicate-folder null? (logior &nil &null))
> +(define-unary-type-predicate-folder nil? (logior &false &nil &null))
>  (define-unary-type-predicate-folder symbol? &symbol)
>  (define-unary-type-predicate-folder variable? &box)
>  (define-unary-type-predicate-folder vector? &vector)
> diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
> index 5c1d71299..61de971fe 100644
> --- a/module/language/cps/types.scm
> +++ b/module/language/cps/types.scm
> @@ -529,13 +529,14 @@ minimum, and maximum."
>  
>  (define-syntax-rule (define-simple-predicate-inferrer predicate type)
>    (define-predicate-inferrer (predicate val true?)
> -    (let ((type (if true?
> -                    type
> -                    (logand (&type val) (lognot type)))))
> -      (restrict! val type -inf.0 +inf.0))))
> +    (let ((type* (logand (&type val)
> +                         (if true?
> +                             type
> +                             (lognot type)))))
> +      (restrict! val type* -inf.0 +inf.0))))
>  (define-simple-predicate-inferrer pair? &pair)
> -(define-simple-predicate-inferrer null? &null)
> -(define-simple-predicate-inferrer nil? &nil)
> +(define-simple-predicate-inferrer null? (logior &nil &null))
> +(define-simple-predicate-inferrer nil? (logior &false &nil &null))
>  (define-simple-predicate-inferrer symbol? &symbol)
>  (define-simple-predicate-inferrer variable? &box)
>  (define-simple-predicate-inferrer vector? &vector)
> diff --git a/test-suite/tests/compiler.test b/test-suite/tests/compiler.test
> index 4f644f339..64bb976fa 100644
> --- a/test-suite/tests/compiler.test
> +++ b/test-suite/tests/compiler.test
> @@ -1,5 +1,5 @@
>  ;;;; compiler.test --- tests for the compiler      -*- scheme -*-
> -;;;; Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
> +;;;; Copyright (C) 2008-2014, 2018 Free Software Foundation, Inc.
>  ;;;; 
>  ;;;; This library is free software; you can redistribute it and/or
>  ;;;; modify it under the terms of the GNU Lesser General Public
> @@ -251,3 +251,52 @@
>  
>    (pass-if-equal "test flonum" 0.0 (test-proc #t))
>    (pass-if-equal "test complex" 0.0+0.0i (test-proc #f)))
> +
> +(with-test-prefix "null? and nil? inference"
> +  (pass-if-equal "nil? after null?"
> +      '((f . f)  ; 3
> +        (f . f)  ; #t
> +        (f . t)  ; #f
> +        (t . t)  ; #nil
> +        (t . t)) ; ()
> +    (map (compile '(lambda (x)
> +                     (if (null? x)
> +                         (cons 't (if (nil? x) 't 'f))
> +                         (cons 'f (if (nil? x) 't 'f)))))
> +         '(3 #t #f #nil ())))
> +
> +  (pass-if-equal "nil? after truth test"
> +      '((t . f)  ; 3
> +        (t . f)  ; #t
> +        (f . t)  ; #f
> +        (f . t)  ; #nil
> +        (t . t)) ; ()
> +    (map (compile '(lambda (x)
> +                     (if x
> +                         (cons 't (if (nil? x) 't 'f))
> +                         (cons 'f (if (nil? x) 't 'f)))))
> +         '(3 #t #f #nil ())))
> +
> +  (pass-if-equal "null? after nil?"
> +      '((f . f)  ; 3
> +        (f . f)  ; #t
> +        (t . f)  ; #f
> +        (t . t)  ; #nil
> +        (t . t)) ; ()
> +    (map (compile '(lambda (x)
> +                     (if (nil? x)
> +                         (cons 't (if (null? x) 't 'f))
> +                         (cons 'f (if (null? x) 't 'f)))))
> +         '(3 #t #f #nil ())))
> +
> +  (pass-if-equal "truth test after nil?"
> +      '((f . t)  ; 3
> +        (f . t)  ; #t
> +        (t . f)  ; #f
> +        (t . f)  ; #nil
> +        (t . t)) ; ()
> +    (map (compile '(lambda (x)
> +                     (if (nil? x)
> +                         (cons 't (if x 't 'f))
> +                         (cons 'f (if x 't 'f)))))
> +         '(3 #t #f #nil ()))))

bug#33036: Bug with the procedure nil? inside a specific code

[Mark H Weaver]

Hi Andy,

Andy Wingo <wingo@pobox.com> writes:
> Thank you, Mark!  That looks great.

Great, thanks for looking it over.  I pushed it to the stable-2.2 branch
as commit c3e14b74e81d0fd3266b97e6bd629cd4e2f98803.

I'm closing this bug now, but feel free to reopen if appropriate.

     Thanks!
       Mark