Hi all,

Please see the patch for an explanation.

Cheers,

Evan
>From 1296b60861ffa567a4d497864a066d05d5312e09 Mon Sep 17 00:00:00 2001
From: Evan Hanson <[email protected]>
Date: Mon, 27 Jan 2014 21:48:12 +1300
Subject: [PATCH] Fix validation for multiple-return procedure types

Validation for procedure types like (a -> . b) relied on the pre-0a52536
behavior of memq, where a failed search on an improper list would return
false rather than raise an error. After that change, such types are
rejected as invalid, so this adds a local memq variant to the
scrutinizer that reproduces the old behavior, as a workaround to
re-support this type syntax.
---
 scrutinizer.scm          |    9 +++++++--
 tests/scrutiny-tests.scm |    3 +++
 2 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index e29e847..695a757 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -1948,6 +1948,11 @@
       (let loop ((lst lst))
        (cond ((eq? lst p) '())
              (else (cons (car lst) (loop (cdr lst)))))))
+    (define (memq* x lst) ; memq, but allow improper list
+      (let loop ((lst lst))
+       (cond ((not (pair? lst)) #f)
+             ((eq? (car lst) x) lst)
+             (else (loop (cdr lst))))))
     (define (validate-llist llist)
       (cond ((null? llist) '())
            ((symbol? llist) '(#!rest *))
@@ -2029,12 +2034,12 @@
                  t))
            ((eq? 'deprecated (car t))
             (and (= 2 (length t)) (symbol? (second t)) t))
-           ((and (list? t) (or (memq '--> t) (memq '-> t))) =>
+           ((or (memq* '--> t) (memq* '-> t)) =>
             (lambda (p)
               (let* ((cleanf (eq? '--> (car p)))
                      (ok (or (not rec) (not cleanf))))
                 (unless rec (set! clean cleanf))
-                (let ((cp (memq ': (cdr p))))
+                (let ((cp (memq* ': p)))
                   (cond ((not cp)
                          (and ok
                               (validate
diff --git a/tests/scrutiny-tests.scm b/tests/scrutiny-tests.scm
index 67ce5a5..3ac754f 100644
--- a/tests/scrutiny-tests.scm
+++ b/tests/scrutiny-tests.scm
@@ -158,3 +158,6 @@
 (apply1 + (list 'a 2 3)) ; <- no type warning (#948)
 (apply1 + (cons 'a (cons 2 (cons 3 '())))) ; <- same here (#952)
 
+;; multiple-value return syntax
+(: mv (-> . *))
+(: mv (procedure () . *))
-- 
1.7.10.4

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to