;;; 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))
;; 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)))
: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.
,@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
(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
;;; 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)
;;; 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
;;; 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
(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
;;; 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)
: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)))
;;;
;;; 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))
(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
projects / sbcl.git / blobdiff