Type inference now knows a rest-argument must be a pair or nil.

diff --git a/v8/src/compiler/midend/typerew.scm b/v8/src/compiler/midend/typerew.scm
index 142356e6fd2c8ee983737621617d8154890b4b5a..b40ba276024e4f4f9b92e3837b5a8012e45b46c1 100644 (file)
--- a/v8/src/compiler/midend/typerew.scm
+++ b/v8/src/compiler/midend/typerew.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: typerew.scm,v 1.23 1996/07/30 19:24:53 adams Exp $
+$Id: typerew.scm,v 1.24 1996/11/14 22:17:26 adams Exp $
 
 Copyright (c) 1994-1996 Massachusetts Institute of Technology
 
@@ -96,18 +96,26 @@ MIT in each case. |#
   ;; . It is a shame to waste the returned information: it tells us the
   ;;   return type and constraints imposed on the arguments, and even if the
   ;;   procedure returns at all.
-  lambda-list                          ; ignored
-  (typerew/expr
-   body
-   (q-env:restrict env effect:unknown)
-   (lambda (quantity type env*)
-     quantity type env*                        ; a shame
-     ;; Creating the procedure or closure itself is no big deal since we dont
-     ;; have reasonable type information for procedures:
-     (typerew/send receiver
-                  (quantity:other-expression form effect:none)
-                  type:compiled-entry
-                  env))))
+  (call-with-values
+      (lambda () (lambda-list/parse lambda-list))
+    (lambda (required optional rest aux)
+      required optional aux            ; ignored
+      rest
+
+      (typerew/expr
+       body
+       (let ((env-at-call-time (q-env:restrict env effect:unknown)))
+        (if rest
+            (q-env:glb/1 env-at-call-time (quantity:variable rest) type:list)
+            env-at-call-time))       
+       (lambda (quantity type env*)
+        quantity type env*             ; a shame
+        ;; Creating the procedure or closure itself is no big deal since
+        ;; we dont have reasonable type information for procedures:
+        (typerew/send receiver
+                      (quantity:other-expression form effect:none)
+                      type:compiled-entry
+                      env))))))
 
 (define-type-rewriter CALL (rator cont #!rest rands)
   cont                                 ; ignored - pre-CPS