>From 39b3649176042897f91942eec5eb67d9690f4c6c Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Sat, 6 Sep 2014 09:10:18 +1200
Subject: [PATCH 5/5] Add scrutiny special case for reverse and specialization
 for null argument

This preserves the element types of list- and null-type arguments to
reverse in its result type (rather than the less specialized list-of).
---
 scrutinizer.scm           |    9 +++++++++
 tests/typematch-tests.scm |    4 ++++
 types.db                  |    4 +++-
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/scrutinizer.scm b/scrutinizer.scm
index d1690b6..1261f8c 100644
--- a/scrutinizer.scm
+++ b/scrutinizer.scm
@@ -2322,6 +2322,15 @@
   (lambda (node args rtypes)
     `((vector ,@(map walked-result (cdr args))))))
 
+(define-special-case reverse
+  (lambda (node args rtypes)
+    (or (and-let* ((subs (node-subexpressions node))
+		   ((= (length subs) 2))
+		   (arg1 (walked-result (second args)))
+		   ((pair? arg1))
+		   ((eq? (car arg1) 'list)))
+	  `((list ,@(reverse (cdr arg1)))))
+	rtypes)))
 
 ;;; Special cases for make-list/make-vector with a known size
 ;
diff --git a/tests/typematch-tests.scm b/tests/typematch-tests.scm
index 4374337..930362f 100644
--- a/tests/typematch-tests.scm
+++ b/tests/typematch-tests.scm
@@ -290,6 +290,10 @@
 (mx (list string string) (make-list 2 "a"))
 (mx (vector * *) (make-vector 2))
 (mx (vector string string) (make-vector 2 "a"))
+(mx null (reverse '()))
+(mx list (reverse (the list (list 1 "2"))))
+(mx (list string fixnum) (reverse (list 1 "2")))
+(mx (list fixnum string) (reverse (cons "1" (cons 2 '()))))
 
 (: f1 (forall (a) ((list-of a) -> a)))
 (define (f1 x) (car x))
diff --git a/types.db b/types.db
index 76e2a85..b554ace 100644
--- a/types.db
+++ b/types.db
@@ -170,7 +170,9 @@
 (append (#(procedure #:clean) append (#!rest *) *)) ; sic
 (##sys#append (#(procedure #:clean) ##sys#append (#!rest *) *))
 
-(reverse (forall (a) (#(procedure #:clean #:enforce) reverse ((list-of a)) (list-of a))))
+;; special cased (see scrutinizer.scm)
+(reverse (forall (a) (#(procedure #:clean #:enforce) reverse ((list-of a)) (list-of a)))
+         ((null) (null) (let ((#(tmp) #(1))) '())))
 
 (memq (forall (a b) (#(procedure #:clean) memq (a (list-of b)) (or false (list-of b))))
       ((* list) (##core#inline "C_u_i_memq" #(1) #(2))))
-- 
1.7.10.4