diff --git a/code/hash-new.lisp b/code/hash-new.lisp
index 1b5012ae6b3f85f4f04e4c7a4f73558c8907f45a..ef8a6fd0363ec884a8745938ad0e1e46ecdb6287 100644
--- a/code/hash-new.lisp
+++ b/code/hash-new.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.14 2000/07/06 05:41:27 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.15 2000/07/06 18:36:36 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -863,12 +863,13 @@
   (let ((data (gensym))
 	(start (gensym))
 	(end (gensym)))
-    `(with-array-data ((,data (the string ,sequence))
+    `(with-array-data ((,data (the (values string &rest t) ,sequence))
 		       (,start)
 		       (,end))
        (if (zerop ,start)
 	   (%sxhash-simple-substring ,data ,end)
-	   (sxhash-simple-string (coerce (the string ,sequence)
+	   (sxhash-simple-string (coerce (the (values string &rest t)
+					      ,sequence)
 					 'simple-string))))))
 
 (defmacro sxhash-list (sequence depth &key (equalp nil))
diff --git a/code/hash.lisp b/code/hash.lisp
index cc6d93e4e668fd6513ee315692ca7b63326f9d1f..9306f590c47e77d26f9ceca1212528a8259fbca6 100644
--- a/code/hash.lisp
+++ b/code/hash.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.38 2000/07/06 05:41:27 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash.lisp,v 1.39 2000/07/06 18:36:37 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -831,12 +831,13 @@
   (let ((data (gensym))
 	(start (gensym))
 	(end (gensym)))
-    `(with-array-data ((,data (the string ,sequence))
+    `(with-array-data ((,data (the (values string &rest t) ,sequence))
 		       (,start)
 		       (,end))
        (if (zerop ,start)
 	   (%sxhash-simple-substring ,data ,end)
-	   (sxhash-simple-string (coerce (the string ,sequence)
+	   (sxhash-simple-string (coerce (the (values string &rest t)
+					      ,sequence)
 					 'simple-string))))))
 
 (defmacro sxhash-list (sequence depth &key (equalp nil))
diff --git a/code/macros.lisp b/code/macros.lisp
index 06cc4edf8757f7767240b093d50cc4400e6d470c..e9cfc3a85cc184dde58e672892890351cfece25c 100644
--- a/code/macros.lisp
+++ b/code/macros.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.61 2000/04/14 03:50:24 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.62 2000/07/06 18:36:38 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -497,11 +497,12 @@
            (declare (ignore ,@dummy-list))
            ,keeper))
       (once-only ((n n))
-	`(case (the fixnum ,n)
+	`(case (the (values fixnum &rest t) ,n)
 	   (0 (nth-value 0 ,form))
 	   (1 (nth-value 1 ,form))
 	   (2 (nth-value 2 ,form))
-	   (T (nth (the fixnum ,n) (multiple-value-list ,form)))))))
+	   (T (nth (the (values fixnum &rest t) ,n)
+			(multiple-value-list ,form)))))))
 
 
 ;;;; SETF and friends.
diff --git a/code/type.lisp b/code/type.lisp
index 2a4da6c05492f632fd192c49722d082b99b17cfb..47f797969ecdb979394a3b7cbc67bfaacb3d53e4 100644
--- a/code/type.lisp
+++ b/code/type.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.35 2000/07/06 04:35:35 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/type.lisp,v 1.36 2000/07/06 18:36:40 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -524,13 +524,24 @@
 ;;; Coerce-To-Values  --  Internal
 ;;;
 ;;; If Type isn't a values type, then make it into one:
-;;;    <type>  ==>  (values type &rest t)
+;;;    <type>  ==>  (values type)
 ;;;
 (defun coerce-to-values (type)
   (declare (type ctype type))
   (if (values-type-p type)
       type
-      (make-values-type :required (list type) :rest *universal-type*)))
+      (make-values-type :required (list type))))
+
+
+;;; Make-canonical-values-type  --  Internal
+;;;
+;;; Make a single value type is possible, otherwise a values-type.
+;;;    (values type)  ==>  <type>
+;;;
+(defun make-canonical-values-type (required optional rest)
+  (if (and required (endp (rest required)) (not optional) (not rest))
+      (first required)
+      (make-values-type :required required :optional optional :rest rest)))
 
 
 ;;; Args-Type-Op  --  Internal
@@ -587,12 +598,12 @@
 					   :from-end t)))
 		  (if (find *empty-type* required :test #'type=)
 		      (values *empty-type* t)
-		      (values (make-values-type
-			       :required required
-			       :optional (if opt-last
-					     (subseq opt 0 (1+ opt-last))
-					     ())
-			       :rest (if (eq rest *empty-type*) nil rest))
+		      (values (make-canonical-values-type
+			       required
+			       (if opt-last
+				   (subseq opt 0 (1+ opt-last))
+				   ())
+			       (if (eq rest *empty-type*) nil rest))
 			      (and rest-exact res-exact)))))))))
       (funcall operation type1 type2)))
 
diff --git a/compiler/array-tran.lisp b/compiler/array-tran.lisp
index f89ed3675c2cf4c5ce18be2e96091686b767e7ae..d37325ab34892cdd2f75d84fbca7e10d081a9a6a 100644
--- a/compiler/array-tran.lisp
+++ b/compiler/array-tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.27 1998/07/24 17:22:26 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/array-tran.lisp,v 1.28 2000/07/06 18:37:00 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -58,7 +58,8 @@
 (defun assert-new-value-type (new-value array)
   (let ((type (continuation-type array)))
     (when (array-type-p type)
-      (assert-continuation-type new-value (array-type-element-type type))))
+      (assert-continuation-optional-type new-value
+					 (array-type-element-type type))))
   (continuation-type new-value))
 
 ;;; Unsupplied-Or-NIL  --  Internal
@@ -193,7 +194,7 @@
 					  (initial-element #\NULL))
   (if (byte-compiling)
       (values nil t)
-      `(make-array (the index ,length)
+      `(make-array (the (values index &rest t) ,length)
 		   :element-type ,element-type
 		   :initial-element ,initial-element)))
 
diff --git a/compiler/checkgen.lisp b/compiler/checkgen.lisp
index 132aab0cac5c44a33bd4104e202451c3ae5eb408..0fd0d37d96b7d66769f81c2af9331c5a9be9dc1a 100644
--- a/compiler/checkgen.lisp
+++ b/compiler/checkgen.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.28 2000/07/06 12:56:19 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.29 2000/07/06 18:37:00 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -140,6 +140,47 @@
 	  types))
 
 
+;;; Values-types-asserted  --  Internal
+;;;
+;;;    Like values-types, but when an argument is proven to be delivered,
+;;; convert asserted optional and rest arguments to required arguments. This
+;;; makes it clear that these required arguments may all be type checked.
+;;;
+(defun values-types-asserted (atype ptype)
+  (declare (type ctype atype ptype))
+  (cond ((eq atype *wild-type*)
+	 (values nil :unknown))
+	((not (values-type-p atype))
+	 (values (list atype) 1))
+	((or (args-type-keyp atype)
+	     (args-type-allowp atype))
+	 (values nil :unknown))
+	(t
+	 (let* ((ptype (kernel::coerce-to-values ptype))
+		(preq (args-type-required ptype))
+		(popt (args-type-optional ptype))
+		(prest (args-type-rest ptype)))
+	   (collect ((types))
+	     (do ((args (args-type-required atype) (rest args)))
+		 ((endp args))
+	       (if (or (pop preq) (pop popt) prest)
+		   (types (single-value-type (first args)))
+		   (return-from values-types-asserted (values nil :unknown))))
+	     (do ((args (args-type-optional atype) (rest args)))
+		 ((endp args))
+	       (if (pop preq)
+		   (types (single-value-type (first args)))
+		   (return-from values-types-asserted (values nil :unknown))))
+	     (let ((arest (args-type-rest atype)))
+	       (when arest
+		 (do ((arg (pop preq) (pop preq)))
+		     ((null arg))
+		   (types (single-value-type arest)))
+		 (when (or popt prest)
+		   (return-from values-types-asserted (values nil :unknown)))))
+	     (values (types) (length (types))))))))
+
+
 ;;; Switch to disable check complementing, for evaluation.
 ;;;
 (defvar *complement-type-checks* t)
@@ -239,7 +280,7 @@
 	(dest (continuation-dest cont)))
     (assert (not (eq atype *wild-type*)))
     (multiple-value-bind (types count)
-	(values-types atype)
+	(values-types-asserted atype (continuation-proven-type cont))
       (cond ((not (eq count :unknown))
 	     (let ((types (no-function-types types)))
 	       (if (or (exit-p dest)
diff --git a/compiler/ir1opt.lisp b/compiler/ir1opt.lisp
index 1ff7dda41e264620251b9105cf8b745c44a8f4c0..85e8a2498fb89e8bac109739bd7d81bae969b0a1 100644
--- a/compiler/ir1opt.lisp
+++ b/compiler/ir1opt.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.69 2000/07/06 18:06:01 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1opt.lisp,v 1.70 2000/07/06 18:37:01 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -200,7 +200,8 @@
 	  (reoptimize-continuation (node-cont node))))))
   (undefined-value))
 
-(declaim (start-block assert-continuation-type assert-call-type))
+(declaim (start-block assert-continuation-type
+		      assert-continuation-optional-type assert-call-type))
 
 ;;; Assert-Continuation-Type  --  Interface
 ;;;
@@ -224,6 +225,18 @@
   (undefined-value))
 
 
+;;; Assert-continuation-optional-type  --  Interface
+;;;
+;;;    Similar to Assert-Continuation-Type, but asserts that the type is
+;;; for an optional argument and that other arguments may be received.
+;;;
+(defun assert-continuation-optional-type (cont type)
+  (declare (type continuation cont) (type ctype type))
+  (let ((opt-type (make-values-type :optional (list type)
+				    :rest *universal-type*)))
+    (assert-continuation-type cont opt-type)))
+
+
 ;;; Assert-Call-Type  --  Interface
 ;;;
 ;;;    Assert that Call is to a function of the specified Type.  It is assumed
@@ -236,23 +249,23 @@
     (dolist (req (function-type-required type))
       (when (null args) (return-from assert-call-type))
       (let ((arg (pop args)))
-	(assert-continuation-type arg req)))
+	(assert-continuation-optional-type arg req)))
     (dolist (opt (function-type-optional type))
       (when (null args) (return-from assert-call-type))
       (let ((arg (pop args)))
-	(assert-continuation-type arg opt)))
+	(assert-continuation-optional-type arg opt)))
 
     (let ((rest (function-type-rest type)))
       (when rest
 	(dolist (arg args)
-	  (assert-continuation-type arg rest))))
+	  (assert-continuation-optional-type arg rest))))
 
     (dolist (key (function-type-keywords type))
       (let ((name (key-info-name key)))
 	(do ((arg args (cddr arg)))
 	    ((null arg))
 	  (when (eq (continuation-value (first arg)) name)
-	    (assert-continuation-type
+	    (assert-continuation-optional-type
 	     (second arg) (key-info-type key)))))))
   (undefined-value))
 
@@ -538,9 +551,8 @@
 		   (return-from find-result-type (undefined-value)))))
 	      (t
 	       (use-union (node-derived-type use)))))
-      (let ((int (values-type-intersection
-		  (continuation-asserted-type result)
-		  (use-union))))
+      (let ((int (values-type-intersection (continuation-asserted-type result)
+					   (use-union))))
 	(setf (return-result-type node) int))))
   (undefined-value))
 
diff --git a/compiler/ir1tran.lisp b/compiler/ir1tran.lisp
index a4f228a9b8dcfeb109b4e7e89d0c45942a2e47d4..93a39cb74842f8f531f0766bdaa6933512240834 100644
--- a/compiler/ir1tran.lisp
+++ b/compiler/ir1tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.114 2000/06/18 15:45:30 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1tran.lisp,v 1.115 2000/07/06 18:37:02 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -745,8 +745,8 @@
   (declare (type continuation fun-cont cont) (list args))
   (let ((node (make-combination fun-cont)))
     (setf (continuation-dest fun-cont) node)
-    (assert-continuation-type fun-cont
-			      (specifier-type '(or function symbol)))
+    (assert-continuation-type
+     fun-cont (values-specifier-type '(values (or function symbol) &rest t)))
     (collect ((arg-conts))
       (let ((this-start fun-cont))
 	(dolist (arg args)
@@ -1138,9 +1138,9 @@
      (if *suppress-values-declaration*
 	 res
 	 (let ((types (cdr spec)))
-	   (do-the-stuff (if (eql (length types) 1)
-			     (car types)
-			     `(values ,@types))
+	   (do-the-stuff (values-specifier-type (if (eql (length types) 1)
+						    (car types)
+						    `(values ,@types)))
 			 cont res 'values))))
     (dynamic-extent
      (when (policy nil (> speed brevity))
@@ -2470,7 +2470,8 @@
 (def-ir1-translator %funcall ((function &rest args) start cont)
   (let ((fun-cont (make-continuation)))
     (ir1-convert start fun-cont function)
-    (assert-continuation-type fun-cont (specifier-type 'function))
+    (assert-continuation-type
+     fun-cont (values-specifier-type '(values function &rest t)))
     (ir1-convert-combination-args fun-cont cont args)))
 
 ;;; This source transform exists to reduce the amount of work for the compiler.
@@ -2884,7 +2885,7 @@
 ;;;
 ;;;    This is somewhat involved, since a type assertion may only be made on a
 ;;; continuation, not on a node.  We can't just set the continuation asserted
-;;; type and let it go at that, since there may be paralell THE's for the same
+;;; type and let it go at that, since there may be parallel THE's for the same
 ;;; continuation, i.e.:
 ;;;     (if ...
 ;;;         (the foo ...)
@@ -2908,10 +2909,9 @@
 ;;; COND branches.  We can't do it here, since we don't know how many branches
 ;;; there are going to be.
 ;;;
-(defun do-the-stuff (type cont lexenv name)
-  (declare (type continuation cont) (type lexenv lexenv))
-  (let* ((ctype (values-specifier-type type))
-	 (old-type (or (lexenv-find cont type-restrictions)
+(defun do-the-stuff (ctype cont lexenv name)
+  (declare (type ctype ctype) (type continuation cont) (type lexenv lexenv))
+  (let* ((old-type (or (lexenv-find cont type-restrictions)
 		       *wild-type*))
 	 (intersects (values-types-intersect old-type ctype))
 	 (int (values-type-intersection old-type ctype))
@@ -2929,13 +2929,21 @@
 
 ;;; THE IR1 Convert  --  Internal
 ;;;
+;;; A THE declaration for a single value type is internally converted
+;;; into (values &optional type &rest t) as this is the commonly
+;;; expected behavior.
+;;;
 (def-ir1-translator the ((type value) start cont)
   "THE Type Form
   Assert that Form evaluates to the specified type (which may be a VALUES
   type.)"
-  (let ((*lexical-environment*
-	 (do-the-stuff type cont *lexical-environment* 'the)))
-      (ir1-convert start cont value)))
+  (let ((ctype (values-specifier-type type)))
+    (unless (values-type-p ctype)
+      (setf ctype (make-values-type :optional (list ctype)
+				    :rest *universal-type*)))
+    (let ((*lexical-environment*
+	   (do-the-stuff ctype cont *lexical-environment* 'the)))
+      (ir1-convert start cont value))))
 
 
 ;;; Truly-The IR1 convert  --  Internal
@@ -3006,8 +3014,10 @@
 ;;;
 (defun set-variable (start cont var value)
   (declare (type continuation start cont) (type basic-var var))
-  (let ((dest (make-continuation)))
-    (setf (continuation-asserted-type dest) (leaf-type var))
+  (let ((dest (make-continuation))
+	(opt-type (make-values-type :optional (list (leaf-type var))
+				    :rest *universal-type*)))
+    (setf (continuation-asserted-type dest) opt-type)
     (ir1-convert start dest value)
     (let ((res (make-set :var var :value dest)))
       (setf (continuation-dest dest) res)
@@ -3168,8 +3178,8 @@
 			    ,fun
 			    (%coerce-to-function ,fun)))))
     (setf (continuation-dest fun-cont) node)
-    (assert-continuation-type fun-cont
-			      (specifier-type '(or function symbol)))
+    (assert-continuation-type
+     fun-cont (values-specifier-type '(values (or function symbol) &rest t)))
     (collect ((arg-conts))
       (let ((this-start fun-cont))
 	(dolist (arg args)
@@ -3481,7 +3491,7 @@
 ;;;
 ;;;    Check a new global function definition for consistency with previous
 ;;; declaration or definition, and assert argument/result types if appropriate.
-;;; This this assertion is suppressed by the EXPLICIT-CHECK attribute, which is
+;;; This assertion is suppressed by the EXPLICIT-CHECK attribute, which is
 ;;; specified on functions that check their argument types as a consequence of
 ;;; type dispatching.  This avoids redundant checks such as NUMBERP on the args
 ;;; to +, etc.
diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp
index b6fbaf9535202ace3187a4321fe135f1250a4268..1643d79fa8ed6ad530d614ce0047e7a2c99ccf0d 100644
--- a/compiler/ir2tran.lisp
+++ b/compiler/ir2tran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.67 1999/02/25 13:03:07 pw Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.68 2000/07/06 18:37:03 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -599,7 +599,7 @@
 ;;;
 ;;;    Return a list of TNs usable in a Call to Template delivering values to
 ;;; Cont.  As an efficiency hack, we pick off the common case where the
-;;; contiuation is fixed values and has locations that satisfy the result
+;;; continuation is fixed values and has locations that satisfy the result
 ;;; restrictions.  This can fail when there is a type check or a values count
 ;;; mismatch.
 ;;;
diff --git a/compiler/locall.lisp b/compiler/locall.lisp
index 73156e4c23f9e537fce2cc03643d639772d9576a..f6f1bfca4c264af76513a79c652a584f4fede639 100644
--- a/compiler/locall.lisp
+++ b/compiler/locall.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/locall.lisp,v 1.48 1999/12/03 16:28:28 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/locall.lisp,v 1.49 2000/07/06 18:37:03 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -46,7 +46,7 @@
     (let ((arg (car args))
 	  (var (car vars)))
       (cond ((leaf-refs var)
-	     (assert-continuation-type arg (leaf-type var)))
+	     (assert-continuation-optional-type arg (leaf-type var)))
 	    (t
 	     (flush-dest arg)
 	     (setf (car args) nil)))))
diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp
index a580559c14010af3995ba681f58d0f3c8780e7de..b04624360a9d9370517b0e02c9e155c1d9c73b85 100644
--- a/compiler/srctran.lisp
+++ b/compiler/srctran.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.99 2000/06/21 17:01:48 dtc Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.100 2000/07/06 18:37:04 dtc Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -32,7 +32,8 @@
 ;;;
 ;;;    Endp is just NULL with a List assertion.
 ;;;
-(def-source-transform endp (x) `(null (the list ,x)))
+(def-source-transform endp (x)
+  `(null (the (values &optional list &rest t) ,x)))
 
 ;;; We turn Identity into Prog1 so that it is obvious that it just returns the
 ;;; first value of its argument.  Ditto for Values with one arg.
@@ -206,13 +207,13 @@
 ;;; use a primitive to handle the cell access case.
 ;;;
 (def-source-transform numerator (num)
-  (once-only ((n-num `(the rational ,num)))
+  (once-only ((n-num `(the (values rational &rest t) ,num)))
     `(if (ratiop ,n-num)
 	 (%numerator ,n-num)
 	 ,n-num)))
 ;;;
 (def-source-transform denominator (num)
-  (once-only ((n-num `(the rational ,num)))
+  (once-only ((n-num `(the (values rational &rest t) ,num)))
     `(if (ratiop ,n-num)
 	 (%denominator ,n-num)
 	 1)))
@@ -3662,14 +3663,14 @@
 (def-source-transform gcd (&rest args)
   (case (length args)
     (0 0)
-    (1 `(abs (the integer ,(first args))))
+    (1 `(abs (the (values integer &rest t) ,(first args))))
     (2 (values nil t))
     (t (associate-arguments 'gcd (first args) (rest args)))))
 
 (def-source-transform lcm (&rest args)
   (case (length args)
     (0 1)
-    (1 `(abs (the integer ,(first args))))
+    (1 `(abs (the (values integer &rest t) ,(first args))))
     (2 (values nil t))
     (t (associate-arguments 'lcm (first args) (rest args)))))