Changeset 5573

Timestamp:

Dec 3, 2006, 1:41:38 AM (18 years ago)

Author:

Gary Byers

Message:

Handle VALUES type specifiers in THE forms a bit.

File:

• trunk/ccl/compiler/nx0.lisp (modified) (2 diffs)

trunk/ccl/compiler/nx0.lisp

@@ -2163 +2163 @@
     new))
 
-
+;;; Treat (VALUES x . y) as X if it appears in a THE form
 (defun nx-form-type (form &optional (env *nx-lexical-environment*))
   (if (self-evaluating-p form)
     (type-of form)
-    (if (and (consp form)               ; Kinda bogus now, but require-type
+    (if (and (consp form)          ; Kinda bogus now, but require-type
              (eq (%car form) 'require-type) ; should be special some day
              (quoted-form-p (caddr form)))
@@ -2175 +2175 @@
           (nx-target-type (nx-declared-type form env))
           (if (consp form)
-            (if (eq (%car form) 'the) 
-              (nx-target-type (cadr form))
+            (if (eq (%car form) 'the)
+              (destructuring-bind (typespec val) (%cdr form)
+                (declare (ignore val))
+                (let* ((ctype (values-specifier-type typespec)))
+                  (if (typep ctype 'values-ctype)
+                    (let* ((req (values-ctype-required ctype)))
+                      (if req
+                        (nx-target-type (type-specifier (car req)))
+                        '*))
+                    (nx-target-type (type-specifier ctype)))))
               (if (eq (%car form) 'setq)
                 (nx-declared-type (cadr form) env)
                 (let* ((op (gethash (%car form) *nx1-operators*)))
-                  (or (and op (cdr (assq op *nx-operator-result-types*)))       ;
+                  (or (and op (cdr (assq op *nx-operator-result-types*)))
                       (and (not op)(cdr (assq (car form) *nx-operator-result-types-by-name*)))
                       (and (memq (car form) *numeric-ops*)