Changeset 12530


Ignore:
Timestamp:
Aug 4, 2009, 4:38:46 PM (10 years ago)
Author:
gz
Message:

Merge fixes in ftype support (r12525, r12529)

Location:
trunk/source
Files:
2 edited

Legend:

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

    r12514 r12530  
    684684           (%cadr acode-expression)))))
    685685
    686 (defun specifier-type-if-known (typespec &optional env &key whine)
    687   (handler-case (specifier-type typespec env)
     686(defun specifier-type-if-known (typespec &optional env &key whine values)
     687  (handler-case (if values (values-specifier-type typespec env) (specifier-type typespec env))
    688688    (parse-unknown-type (c)
    689689      (when (and whine *compiler-warn-on-undefined-type-references*)
     
    19731973(defun find-ftype-decl (sym &optional (env *nx-lexical-environment*))
    19741974  (setq sym (maybe-setf-function-name sym))
    1975   (loop
    1976     (when (listp env)
    1977       (return (and (symbolp sym)
    1978                    (proclaimed-ftype sym))))
     1975  (loop
     1976    (when (listp env) (return  (proclaimed-ftype sym)))
    19791977    (dolist (fdecl (lexenv.fdecls env))
    19801978      (when (and (eq (car fdecl) sym)
    19811979                 (eq (car (%cdr fdecl)) 'ftype))
    19821980        (return-from find-ftype-decl (%cddr fdecl))))
     1981    (when (and (istruct-typep env 'lexical-environment)
     1982               (assq sym (lexenv.functions env)))
     1983      (return-from find-ftype-decl nil))
    19831984    (setq env (lexenv.parent-env env))))
    19841985
     
    20002001              (nargs (if spread-p (1- (length arglist)) (length arglist))))
    20012002          (flet ((collect-type (arg type)
    2002                    (push (if (and type (neq type *universal-type*) (neq type *wild-type*))
    2003                            `(the ,(type-specifier type) ,arg)
    2004                            arg)
    2005                          typed-arglist))
    2006                  (key-name (x) (key-info-name x))
     2003                   (push (if (and type
     2004                                  (neq type *universal-type*)
     2005                                  (neq type *wild-type*)
     2006                                  (setq type (type-specifier type))
     2007                                  ;; Don't record unknown types, just causes spurious warnings.
     2008                                  (specifier-type-if-known type env :values t))
     2009                             `(the ,type ,arg)
     2010                             arg)
     2011                         typed-arglist))
     2012                 (key-name (x) (key-info-name x))
    20072013                 (whine (&rest reason)
    20082014                   (nx1-whine :ftype-mismatch sym reason arglist spread-p)
  • trunk/source/level-1/l1-streams.lisp

    r12240 r12530  
    347347
    348348(defmethod stream-clear-input ((x t))
    349   (report-bad-arg x 'stream))
     349  (report-bad-arg x 'input-stream))
    350350
    351351(defmethod stream-clear-input ((stream input-stream)) nil)
Note: See TracChangeset for help on using the changeset viewer.