X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1tran.lisp;h=c6cf4d0bdd421c7f799e88524dc27cde1cb5d351;hb=8886298f2c0e50e595cf481c426b6331ab898a23;hp=6516ca2680e69911ea27245204a96682c2031f4d;hpb=d604a358d8e5eb5587989e0a4f1d31dbe6ac5ffe;p=sbcl.git diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp index 6516ca2..c6cf4d0 100644 --- a/src/compiler/ir1tran.lisp +++ b/src/compiler/ir1tran.lisp @@ -64,7 +64,7 @@ ;;; Return a GLOBAL-VAR structure usable for referencing the global ;;; function NAME. -(defun find-free-really-fun (name) +(defun find-global-fun (name latep) (unless (info :function :kind name) (setf (info :function :kind name) :function) (setf (info :function :where-from name) :assumed)) @@ -75,15 +75,22 @@ ;; running Lisp. But at cross-compile time, the current ;; definedness of a function is irrelevant to the ;; definedness at runtime, which is what matters. - #-sb-xc-host (not (fboundp name))) + #-sb-xc-host (not (fboundp name)) + ;; LATEP is true when the user has indicated that + ;; late-late binding is desired by using eg. a quoted + ;; symbol -- in which case it makes little sense to + ;; complain about undefined functions. + (not latep)) (note-undefined-reference name :function)) (make-global-var :kind :global-function :%source-name name - :type (if (or *derive-function-types* - (eq where :declared) - (and (member name *fun-names-in-this-file* :test #'equal) - (not (fun-lexically-notinline-p name)))) + :type (if (and (not latep) + (or *derive-function-types* + (eq where :declared) + (and (member name *fun-names-in-this-file* + :test #'equal) + (not (fun-lexically-notinline-p name))))) (info :function :type name) (specifier-type 'function)) :where-from where))) @@ -165,7 +172,7 @@ :type (if (eq inlinep :notinline) (specifier-type 'function) (info :function :type name))) - (find-free-really-fun name)))))))) + (find-global-fun name nil)))))))) ;;; Return the LEAF structure for the lexically apparent function ;;; definition of NAME. @@ -463,7 +470,8 @@ ,@body (return-from ,skip nil))))) (ir1-convert ,start ,next ,result - (make-compiler-error-form ,condition ,form))))))) + (make-compiler-error-form ,condition + ,form))))))) ;; Translate FORM into IR1. The code is inserted as the NEXT of the ;; CTRAN START. RESULT is the LVAR which receives the value of the @@ -509,8 +517,9 @@ (aver (and (consp lexical-def) (eq (car lexical-def) 'macro))) (ir1-convert start next result - (careful-expand-macro (cdr lexical-def) - form)))))) + (careful-expand-macro + (cdr lexical-def) + form)))))) ((or (atom opname) (not (eq (car opname) 'lambda))) (compiler-error "illegal function call")) (t @@ -922,15 +931,15 @@ ;;; If a LAMBDA-VAR being bound, we intersect the type with the var's ;;; type, otherwise we add a type restriction on the var. If a symbol ;;; macro, we just wrap a THE around the expansion. -(defun process-type-decl (decl res vars) +(defun process-type-decl (decl res vars context) (declare (list decl vars) (type lexenv res)) (let ((type (compiler-specifier-type (first decl)))) (collect ((restr nil cons) (new-vars nil cons)) (dolist (var-name (rest decl)) (when (boundp var-name) - (compiler-assert-symbol-home-package-unlocked - var-name "declaring the type of ~A")) + (program-assert-symbol-home-package-unlocked + context var-name "declaring the type of ~A")) (let* ((bound-var (find-in-bindings vars var-name)) (var (or bound-var (lexenv-find var-name vars) @@ -985,15 +994,15 @@ ;;; declarations for functions being bound, we must also deal with ;;; declarations that constrain the type of lexically apparent ;;; functions. -(defun process-ftype-decl (spec res names fvars) +(defun process-ftype-decl (spec res names fvars context) (declare (type list names fvars) (type lexenv res)) (let ((type (compiler-specifier-type spec))) (collect ((res nil cons)) (dolist (name names) (when (fboundp name) - (compiler-assert-symbol-home-package-unlocked - name "declaring the ftype of ~A")) + (program-assert-symbol-home-package-unlocked + context name "declaring the ftype of ~A")) (let ((found (find name fvars :key #'leaf-source-name :test #'equal))) (cond (found @@ -1013,11 +1022,12 @@ ;;; special declaration is instantiated by throwing a special variable ;;; into the variables if BINDING-FORM-P is NIL, or otherwise into ;;; *POST-BINDING-VARIABLE-LEXENV*. -(defun process-special-decl (spec res vars binding-form-p) +(defun process-special-decl (spec res vars binding-form-p context) (declare (list spec vars) (type lexenv res)) (collect ((new-venv nil cons)) (dolist (name (cdr spec)) - (compiler-assert-symbol-home-package-unlocked name "declaring ~A special") + (program-assert-symbol-home-package-unlocked + context name "declaring ~A special") (let ((var (find-in-bindings vars name))) (etypecase var (cons @@ -1066,6 +1076,8 @@ (defined-fun-inline-expansion var)) (setf (defined-fun-functional res) (defined-fun-functional var))) + ;; FIXME: Is this really right? Needs we not set the FUNCTIONAL + ;; to the original global-var? res)) ;;; Parse an inline/notinline declaration. If it's a local function we're @@ -1192,18 +1204,18 @@ ;;; Process a single declaration spec, augmenting the specified LEXENV ;;; RES. Return RES and result type. VARS and FVARS are as described ;;; PROCESS-DECLS. -(defun process-1-decl (raw-spec res vars fvars binding-form-p) +(defun process-1-decl (raw-spec res vars fvars binding-form-p context) (declare (type list raw-spec vars fvars)) (declare (type lexenv res)) (let ((spec (canonized-decl-spec raw-spec)) (result-type *wild-type*)) (values (case (first spec) - (special (process-special-decl spec res vars binding-form-p)) + (special (process-special-decl spec res vars binding-form-p context)) (ftype (unless (cdr spec) (compiler-error "no type specified in FTYPE declaration: ~S" spec)) - (process-ftype-decl (second spec) res (cddr spec) fvars)) + (process-ftype-decl (second spec) res (cddr spec) fvars context)) ((inline notinline maybe-inline) (process-inline-decl spec res fvars)) ((ignore ignorable) @@ -1224,7 +1236,7 @@ :handled-conditions (process-unmuffle-conditions-decl spec (lexenv-handled-conditions res)))) (type - (process-type-decl (cdr spec) res vars)) + (process-type-decl (cdr spec) res vars context)) (values (unless *suppress-values-declaration* (let ((types (cdr spec))) @@ -1259,8 +1271,8 @@ ;;; ;;; This is also called in main.lisp when PROCESS-FORM handles a use ;;; of LOCALLY. -(defun process-decls (decls vars fvars &key (lexenv *lexenv*) - (binding-form-p nil)) +(defun process-decls (decls vars fvars &key + (lexenv *lexenv*) (binding-form-p nil) (context :compile)) (declare (list decls vars fvars)) (let ((result-type *wild-type*) (*post-binding-variable-lexenv* nil)) @@ -1269,7 +1281,7 @@ (unless (consp spec) (compiler-error "malformed declaration specifier ~S in ~S" spec decl)) (multiple-value-bind (new-env new-result-type) - (process-1-decl spec lexenv vars fvars binding-form-p) + (process-1-decl spec lexenv vars fvars binding-form-p context) (setq lexenv new-env) (unless (eq new-result-type *wild-type*) (setq result-type