[Chicken-hackers] Some undefined patches

[megane]

Hi,

The scrutinizer currently converts the 'undefined' type into '(*) at
couple of places. Namely in variable references and from the
##core#undefined nodes. This patches fixes that.

Another change is considering 'undefined' as a truthy value. The
interpreter considers 'undefined' truthy, too.

An unfortunate effect of printing mutated expressions can be seen in the
messages. An 'if' node is optimized to a 'let' node, and in the warning
message the original 'if' is printed but the warning is for the 'let'.
That's pretty confusing.

I'm considering of printing both the original and the mutated expression
in the warning if the two differ too much. But this needs more thought.

>From c7f0c83ebeffba9f4a8aa45394285e4f582d7a89 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Sun, 24 Mar 2019 12:42:40 +0200
Subject: [PATCH 1/4] Make type of (##core#undefined) 'undefined'

---
 scrutinizer.scm         | 2 +-
 tests/scrutiny.expected | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 7ceb830..91732b4 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -444,7 +444,7 @@
               (case class
                 ((##core#the/result) (list (first params))) ; already walked
                 ((quote) (list (constant-result (first params))))
-                ((##core#undefined) '(*))
+                ((##core#undefined) '(undefined))
                 ((##core#proc) '(procedure))
                 ((##core#variable) (variable-result (first params) e loc n 
flow))
                 ((##core#inline_ref)
diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 2396a53..1d09ae9 100644
--- a/tests/scrutiny.expected
+++ b/tests/scrutiny.expected
@@ -224,7 +224,7 @@ Note: Test is always true
 
   Test condition has always true value of type:
 
-    (-> *)
+    (-> undefined)
 
 Warning: Invalid argument
   In file `scrutiny-tests.scm:XXX',
-- 
2.7.4

>From 3688dc722f59de43045310cf2735d9c3c106d620 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Sun, 24 Mar 2019 13:45:43 +0200
Subject: [PATCH 2/4] Make 'undefined' a truthy value

The interpreter considers undefined a truthy value too:

(if (begin) 1 2) => 1
---
 scrutinizer.scm                           |  2 +-
 tests/scrutinizer-message-format.expected | 36 +++++++++++++++++++++++++++++++
 tests/scrutinizer-tests.scm               |  1 +
 tests/typematch-tests.scm                 |  3 +++
 4 files changed, 41 insertions(+), 1 deletion(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 91732b4..d4eb347 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -260,7 +260,7 @@
               ((not) (not (always-true1 (second t))))
               ((forall) (always-true1 (third t)))
               (else #t)))
-           ((memq t '(* boolean false undefined noreturn)) #f)
+           ((memq t '(* boolean false noreturn)) #f)
            (else #t)))
 
     (define (always-true if-node test-node t loc)
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 7688ca1..562c4c2 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -721,6 +721,42 @@ Warning: Zero values for conditional
 
     (scheme#values)
 
+Note: Test is always true
+  In file `test-scrutinizer-message-format.scm:XXX',
+  In module `m',
+  In procedure `toplevel-foo',
+  In procedure `local-bar',
+  In procedure `r-conditional-value-count-invalid',
+  In procedure `zero-values-for-conditional',
+  In conditional expression:
+
+    (if (scheme#values) 1 (##core#undefined))
+
+  Test condition has always true value of type:
+
+    undefined
+
+Warning: Let binding to `gXXX' has zero values
+  In file `test-scrutinizer-message-format.scm:XXX',
+  In module `m',
+  In procedure `toplevel-foo',
+  In procedure `local-bar',
+  In procedure `r-conditional-value-count-invalid',
+  In procedure `zero-values-for-conditional',
+  In let expression:
+
+    (if (scheme#values) 1 (##core#undefined))
+
+  Variable `gXXX' is bound to an expression that returns 0 values.
+
+  It is a call to `values' from module `scheme' which has this type:
+
+    (procedure (#!rest values) . *)
+
+  This is the expression:
+
+    (scheme#values)
+
 Warning: Too many values for conditional
   In file `test-scrutinizer-message-format.scm:XXX',
   In module `m',
diff --git a/tests/scrutinizer-tests.scm b/tests/scrutinizer-tests.scm
index 939351a..40b11cd 100644
--- a/tests/scrutinizer-tests.scm
+++ b/tests/scrutinizer-tests.scm
@@ -69,6 +69,7 @@
 
 (test (= undefined undefined))
 (test (< undefined *))
+(test (>< undefined false))
 
 ;;; noreturn
 
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index ac2d447..c234d45 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -427,4 +427,7 @@
 
 (infer true (= 3 (+ 1 2))) ; Constant folding should happen before / during 
scrutiny
 
+;; Undefined is truthy.
+(infer fixnum (if (begin) 1 #f))
+
 (test-exit)
-- 
2.7.4

>From af54037728c7c0222724b4321acf065da10cd608 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Sun, 24 Mar 2019 14:14:42 +0200
Subject: [PATCH 3/4] Propagate the 'undefined type from variable references

Previously this didn't warn:

  (let ((a (print "foo")))
    (+ a 1))

Now it does.

* scrutinizer.scm (scrutinize -> variable-result): The old code turns
  'undefined into '*. Don't do that anymore.
---
 scrutinizer.scm                           | 10 +---------
 tests/scrutinizer-message-format.expected | 13 +++++++++++++
 tests/typematch-tests.scm                 |  4 ++++
 3 files changed, 18 insertions(+), 9 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index d4eb347..34409f4 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -242,15 +242,7 @@
                  (db-get db id 'assigned) 
                  (not (variable-mark id '##compiler#type-source)))
             '(*))
-           ((assq id e) =>
-            (lambda (a)
-              (cond ((eq? 'undefined (cdr a))
-                     #;(report
-                      loc
-                      "access to variable `~a' which has an undefined value"
-                      (real-name id db))
-                     '(*))
-                    (else (list (cdr a))))))
+           ((assq id e) => (lambda (a) (list (cdr a))))
            (else (global-result id loc node))))
 
     (define (always-true1 t)
diff --git a/tests/scrutinizer-message-format.expected 
b/tests/scrutinizer-message-format.expected
index 562c4c2..ab0321b 100644
--- a/tests/scrutinizer-message-format.expected
+++ b/tests/scrutinizer-message-format.expected
@@ -92,6 +92,19 @@ Warning: Let binding to `gXXX' has zero values
 
     (scheme#values)
 
+Warning: Invalid procedure
+  In file `test-scrutinizer-message-format.scm:XXX',
+  In procedure `r-proc-call-argument-value-count',
+  In procedure call:
+
+    (gXXX)
+
+  Variable `gXXX' is not a procedure.
+
+  It has this type:
+
+    undefined
+
 Warning: Branch values mismatch
   In file `test-scrutinizer-message-format.scm:XXX',
   In procedure `r-cond-branch-value-count-mismatch',
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index c234d45..f42edcc 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -430,4 +430,8 @@
 ;; Undefined is truthy.
 (infer fixnum (if (begin) 1 #f))
 
+;; Variables can have 'undefined as a type
+(let ((a (print 1)))
+  (compiler-typecase a (undefined 1)))
+
 (test-exit)
-- 
2.7.4

>From 0bbaa1010342c84264f4415f264fc34f24b83082 Mon Sep 17 00:00:00 2001
From: megane <address@hidden>
Date: Sun, 24 Mar 2019 14:17:58 +0200
Subject: [PATCH 4/4] Fix type of force-finalizers

This is a parameter with boolean value.
---
 types.db | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/types.db b/types.db
index fcf9d9b..b5bc766 100644
--- a/types.db
+++ b/types.db
@@ -1380,7 +1380,7 @@
 ;; gc
 
 (chicken.gc#current-gc-milliseconds (#(procedure #:clean) 
chicken.gc#current-gc-milliseconds () integer))
-(chicken.gc#force-finalizers (procedure chicken.gc#force-finalizers () 
undefined))
+(chicken.gc#force-finalizers (procedure chicken.gc#force-finalizers 
(#!optional boolean) boolean))
 (chicken.gc#gc (#(procedure #:clean) chicken.gc#gc (#!optional *) fixnum))
 (chicken.gc#memory-statistics (#(procedure #:clean) 
chicken.gc#memory-statistics () (vector-of fixnum)))
 (chicken.gc#set-finalizer! (#(procedure #:clean #:enforce) 
chicken.gc#set-finalizer! (* (procedure (*) . *)) *))
-- 
2.7.4