From: Stephen Adams <edu/mit/csail/zurich/adams>
Date: Thu, 14 Nov 1996 22:17:26 +0000 (+0000)
Subject: Type inference now knows a rest-argument must be a pair or nil.
X-Git-Tag: 20090517-FFI~5328
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=83225c51b09ae8ec829b6e06e11aea70bf70297c;p=mit-scheme.git

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 142356e6f..b40ba2760 100644
--- 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