Changeset 12276


Ignore:
Timestamp:
Jun 23, 2009, 1:12:35 PM (10 years ago)
Author:
gb
Message:

Handle some cases of nested THE correctly (ticket:543).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx1.lisp

    r12219 r12276  
    2929  ;; in type declarations, but aren't legal args to TYPEP;
    3030  ;; treat them as the simple FUNCTION type.
    31   (let* ((ctype (handler-case (values-specifier-type typespec env)
    32                   (parse-unknown-type (c)
    33                     (nx1-whine :unknown-type-in-declaration (parse-unknown-type-specifier c))
    34                     nil)
    35                   (program-error (c)
    36                     (nx1-whine :invalid-type typespec c)
    37                     nil))))
    38     (if (or (null ctype) (typep ctype 'values-ctype))
    39       (setq typespec '*)
    40       (if (typep ctype 'function-ctype)
    41         (setq typespec 'function)       ; better than nothing.
    42         (setq typespec (nx-target-type (type-specifier ctype))))))
    43   (let* ((*nx-form-type* typespec)
    44          (transformed (nx-transform form env)))
    45     (when (and (consp transformed)
    46                (eq (car transformed) 'the))
    47       (setq transformed form))
    48     (make-acode
    49      (%nx1-operator typed-form)
    50      typespec
    51      (nx1-transformed-form transformed env)
    52      (nx-declarations-typecheck env))))
     31  (flet ((typespec-for-the (typespec)
     32           (let* ((ctype (handler-case (values-specifier-type (nx-target-type typespec) env)
     33                           (parse-unknown-type (c)
     34                                               (nx1-whine :unknown-type-in-declaration (parse-unknown-type-specifier c))
     35                                               nil)
     36                           (program-error (c)
     37                                          (nx1-whine :invalid-type typespec c)
     38                                          nil))))
     39             (if (or (null ctype) (typep ctype 'values-ctype))
     40               '*
     41               (if (typep ctype 'function-ctype)
     42                 'function
     43                 (nx-target-type (type-specifier ctype)))))))
     44    (let* ((typespec (typespec-for-the typespec))
     45           (*nx-form-type* typespec)
     46           (transformed (nx-transform form env)))
     47      (do* ()
     48           ((or (atom transformed)
     49                (not (eq (car transformed) 'the))))
     50        (destructuring-bind (ftype form) (cdr transformed)
     51          (setq typespec (nx-target-type (nx1-type-intersect call typespec (typespec-for-the ftype)))
     52                transformed form)))
     53      (make-acode
     54       (%nx1-operator typed-form)
     55       typespec
     56       (nx1-transformed-form transformed env)
     57       (nx-declarations-typecheck env)))))
    5358
    5459(defnx1 nx1-struct-ref struct-ref (&whole whole structure offset)
Note: See TracChangeset for help on using the changeset viewer.