>From b6a170cbe9d0eee1ca882bb25ca1813ff6bcfdd5 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 10 Feb 2012 13:45:15 +0100
Subject: [PATCH 1/2] fixed bug in handling of scrutinizer special cases for
 vector-ref/list-ref/list-tail when too few arguments
 where given

Signed-off-by: Peter Bex <address@hidden>
---
 scrutinizer.scm |   76 ++++++++++++++++++++++++++++--------------------------
 1 files changed, 39 insertions(+), 37 deletions(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index 332ed2e..e9f3414 100755
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2157,55 +2157,57 @@
 
 (let ()
   (define (vector-ref-result-type node args rtypes)
-    (or (let ((subs (node-subexpressions node))
-	      (arg1 (second args)))
-	  (and (pair? arg1)
-	       (eq? 'vector (car arg1))
-	       (= (length subs) 3)
-	       (let ((index (third subs)))
-		 (and (eq? 'quote (node-class index))
-		      (let ((val (first (node-parameters index))))
-			(and (fixnum? val)
-			     (>= val 0) (< val (length (cdr arg1))) ;XXX could warn on failure (but needs location)
-			     (list (list-ref (cdr arg1) val))))))))
+    (or (and-let* ((subs (node-subexpressions node))
+                   ((= (length subs) 3))
+                   (arg1 (second args))
+                   ((pair? arg1))
+                   ((eq? 'vector (car arg1)))
+                   (index (third subs))
+                   ((eq? 'quote (node-class index)))
+                   (val (first (node-parameters index)))
+                   ((fixnum? val))
+                   ((>= val 0))
+                   ((< val (length (cdr arg1))))) ;XXX could warn on failure (but needs location)
+          (list (list-ref (cdr arg1) val)))
 	rtypes))
   (define-special-case vector-ref vector-ref-result-type)
   (define-special-case ##sys#vector-ref vector-ref-result-type))
 
 (let ()
   (define (list-ref-result-type node args rtypes)
-    (or (let ((subs (node-subexpressions node))
-	      (arg1 (second args)))
-	  (and (pair? arg1)
-	       (eq? 'list (car arg1))
-	       (= (length subs) 3)
-	       (let ((index (third subs)))
-		 (and (eq? 'quote (node-class index))
-		      (let ((val (first (node-parameters index))))
-			(and (fixnum? val)
-			     (>= val 0) (< val (length (cdr arg1))) ;XXX could warn on failure (but needs location)
-			     (list (list-ref (cdr arg1) val))))))))
+    (or (and-let* ((subs (node-subexpressions node))
+                   ((= (length subs) 3))
+                   (arg1 (second args))
+                   ((pair? arg1))
+                   ((eq? 'list (car arg1)))
+                   (index (third subs))
+                   ((eq? 'quote (node-class index)))
+                   (val (first (node-parameters index)))
+                   ((fixnum? val))
+                   ((>= val 0))  ;XXX could warn on failure (but needs location)
+                   ((< val (length (cdr arg1)))))
+          (list (list-ref (cdr arg1) val)))
 	rtypes))
   (define-special-case list-ref list-ref-result-type)
   (define-special-case ##sys#list-ref list-ref-result-type))
 
 (define-special-case list-tail
   (lambda (node args rtypes)
-    (or (let ((subs (node-subexpressions node))
-	      (arg1 (second args)))
-	  (and (pair? arg1)
-	       (eq? 'list (car arg1))
-	       (= (length subs) 3)
-	       (let ((index (third subs)))
-		 (and (eq? 'quote (node-class index))
-		      (let ((val (first (node-parameters index))))
-			(and (fixnum? val)
-			     (>= val 0) (< val (length (cdr arg1))) ;XXX could warn on failure (but needs location)
-			     (let ((rest (list-tail (cdr arg1) val)))
-			       (list
-				(if (null? rest)
-				    'null
-				    `(list ,@rest))))))))))
+    (or (and-let* ((subs (node-subexpressions node))
+                   ((= (length subs) 3))
+                   (arg1 (second args))
+                   ((pair? arg1))
+                   ((eq? 'list (car arg1)))
+                   (index (third subs))
+                   ((eq? 'quote (node-class index)))
+                   (val (first (node-parameters index)))
+                   ((fixnum? val))
+                   ((>= val 0))
+                   ((< val (length (cdr arg1)))))   ;XXX could warn on failure (but needs location)
+          (let ((rest (list-tail (cdr arg1) val)))
+            (list (if (null? rest)
+                      'null
+                      `(list ,@rest)))))
 	rtypes)))
 
 (define-special-case list
-- 
1.7.9.1