X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fctype.lisp;h=97923ac7d42e6d7b8bc1189fc3f2a24c8e59b8eb;hb=b0642df835dc2fca3e4cf47aff978ecdc88799d5;hp=3fb91d173db646da3fa5b97bda7d2cbc308f203e;hpb=a0a198faba322eccaf947862b59946aed99b2347;p=sbcl.git diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index 3fb91d1..97923ac 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -672,7 +672,7 @@ (try-type-intersections (vars) (res) where)))) -;;; Check that Type doesn't specify any funny args, and do the +;;; Check that TYPE doesn't specify any funny args, and do the ;;; intersection. (defun find-lambda-types (lambda type where) (declare (type clambda lambda) (type fun-type type) (string where)) @@ -742,7 +742,8 @@ ((not really-assert) t) (t (when atype - (assert-continuation-type (return-result return) atype)) + (assert-continuation-type (return-result return) atype + (lexenv-policy (functional-lexenv functional)))) (loop for var in vars and type in types do (cond ((basic-var-sets var) (when (and unwinnage-fun @@ -760,6 +761,17 @@ (derive-node-type ref type))))) t)))))) +(defun assert-global-function-definition-type (name fun) + (declare (type functional fun)) + (let ((type (info :function :type name)) + (where (info :function :where-from name))) + (when (eq where :declared) + (setf (leaf-type fun) type) + (assert-definition-type fun type + :unwinnage-fun #'compiler-note + :where "proclamation")))) + +;;;; FIXME: Move to some other file. (defun check-catch-tag-type (tag) (declare (type continuation tag)) (let ((ctype (continuation-type tag)))