X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=fb80dc3958d334fb07f57285576f16308ecaffb0;hb=0a82f2db352cc348d2107a882e50af222ff97ed3;hp=00ca92d1a616fa57856ee0e993802ad771f483c3;hpb=a26fc2e03904bd0dac626a43e169e2e3514344d4;p=sbcl.git diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 00ca92d..fb80dc3 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -26,7 +26,7 @@ `(eval-when (:compile-toplevel :load-toplevel :execute) (setq *package* (find-undeleted-package-or-lose ',package-designator)))) -;;; MULTIPLE-VALUE-FOO +;;;; MULTIPLE-VALUE-FOO (defun list-of-symbols-p (x) (and (listp x) @@ -141,63 +141,109 @@ (defmacro-mundanely prog2 (form1 result &body body) `(prog1 (progn ,form1 ,result) ,@body)) -;;; Now that we have the definition of MULTIPLE-VALUE-BIND, we can make a -;;; reasonably readable definition of DEFUN. -;;; -;;; DEFUN expands into %DEFUN which is a function that is treated -;;; magically by the compiler (through an IR1 transform) in order to -;;; handle stuff like inlining. After the compiler has gotten the -;;; information it wants out of macro definition, it compiles a call -;;; to %%DEFUN which happens at load time. -(defmacro-mundanely defun (&whole whole name args &body body) +;;;; DEFUN + +;;; Should we save the inline expansion of the function named NAME? +(defun inline-fun-name-p (name) + (or + ;; the normal reason for saving the inline expansion + (info :function :inlinep name) + ;; another reason for saving the inline expansion: If the + ;; ANSI-recommended idiom + ;; (DECLAIM (INLINE FOO)) + ;; (DEFUN FOO ..) + ;; (DECLAIM (NOTINLINE FOO)) + ;; has been used, and then we later do another + ;; (DEFUN FOO ..) + ;; without a preceding + ;; (DECLAIM (INLINE FOO)) + ;; what should we do with the old inline expansion when we see the + ;; new DEFUN? Overwriting it with the new definition seems like + ;; the only unsurprising choice. + (info :function :inline-expansion-designator name))) + +;;; Now that we have the definition of MULTIPLE-VALUE-BIND, we can +;;; make a reasonably readable definition of DEFUN. +(defmacro-mundanely defun (&environment env name args &body body) + "Define a function at top level." + #+sb-xc-host + (unless (symbol-package (fun-name-block-name name)) + (warn "DEFUN of uninterned symbol ~S (tricky for GENESIS)" name)) (multiple-value-bind (forms decls doc) (parse-body body) - (let ((def `(lambda ,args - ,@decls - (block ,(function-name-block-name name) - ,@forms)))) - `(sb!c::%defun ',name #',def ,doc ',whole)))) -#+sb-xc-host (/show "before PROCLAIM" (sb!c::info :function :kind 'sb!c::%%defun)) -#+sb-xc-host (sb!xc:proclaim '(ftype function sb!c::%%defun)) ; to avoid - ; undefined function warnings -#+sb-xc-host (/show "after PROCLAIM" (sb!c::info :function :kind 'sb!c::%%defun)) -(defun sb!c::%%defun (name def doc &optional inline-expansion) + (let* ((lambda `(lambda ,args + ,@decls + (block ,(fun-name-block-name name) + ,@forms))) + (want-to-inline ) + (inline-lambda + (cond (;; Does the user not even want to inline? + (not (inline-fun-name-p name)) + nil) + (;; Does inlining look too hairy to handle? + (not (sb!c:lambda-independent-of-lexenv-p lambda env)) + (sb!c:maybe-compiler-note + "lexical environment too hairy, can't inline DEFUN ~S" + name) + nil) + (t + ;; FIXME: The only reason that we return + ;; LAMBDA-WITH-LEXENV instead of returning bare + ;; LAMBDA is to avoid modifying downstream code + ;; which expects LAMBDA-WITH-LEXENV. But the code + ;; here is the only code which feeds into the + ;; downstream code, and the generality of the + ;; interface is no longer used, so it'd make sense + ;; to simplify the interface instead of using the + ;; old general LAMBDA-WITH-LEXENV interface in this + ;; simplified way. + `(sb!c:lambda-with-lexenv + nil nil nil ; i.e. no DECLS, no MACROS, no SYMMACS + ,@(rest lambda)))))) + `(progn + + ;; In cross-compilation of toplevel DEFUNs, we arrange + ;; for the LAMBDA to be statically linked by GENESIS. + #+sb-xc-host + (cold-fset ,name ,lambda) + + (eval-when (:compile-toplevel :load-toplevel :execute) + (sb!c:%compiler-defun ',name ',inline-lambda)) + + (%defun ',name + ;; In normal compilation (not for cold load) this is + ;; where the compiled LAMBDA first appears. In + ;; cross-compilation, we manipulate the + ;; previously-statically-linked LAMBDA here. + #-sb-xc-host ,lambda + #+sb-xc-host (fdefinition ',name) + ,doc))))) +#-sb-xc-host +(defun %defun (name def doc) + (declare (type function def)) + (declare (type (or null simple-string doc))) + (/show0 "entering %DEFUN, name (or block name) = ..") + (/primitive-print (symbol-name (fun-name-block-name name))) + (aver (legal-fun-name-p name)) (when (fboundp name) + (/show0 "redefining NAME") (style-warn "redefining ~S in DEFUN" name)) + (/show0 "setting FDEFINITION") (setf (sb!xc:fdefinition name) def) (when doc - ;; FIXME: This should use shared SETF-name parsing logic. + ;; FIXME: This should use shared SETF-name-parsing logic. + (/show0 "setting FDOCUMENTATION") (if (and (consp name) (eq (first name) 'setf)) (setf (fdocumentation (second name) 'setf) doc) - (setf (fdocumentation name 'function) doc))) - (sb!c::proclaim-as-function-name name) - (if (eq (info :function :where-from name) :assumed) - (progn - (setf (info :function :where-from name) :defined) - (if (info :function :assumed-type name) - (setf (info :function :assumed-type name) nil)))) - (when (or inline-expansion - (info :function :inline-expansion name)) - (setf (info :function :inline-expansion name) - inline-expansion)) + (setf (fdocumentation (the symbol name) 'function) doc))) + (/show0 "leaving %DEFUN") name) -;;; Ordinarily this definition of SB!C:%DEFUN as an ordinary function is not -;;; used: the parallel (but different) definition as an IR1 transform takes -;;; precedence. However, it's still good to define this in order to keep the -;;; interpreter happy. We define it here (instead of alongside the parallel -;;; IR1 transform) because while the IR1 transform is needed and appropriate -;;; in the cross-compiler running in the host Common Lisp, this parallel -;;; ordinary function definition is only appropriate in the target Lisp. -(defun sb!c::%defun (name def doc source) - (declare (ignore source)) - (setf (sb!eval:interpreted-function-name def) name) - (sb!c::%%defun name def doc)) ;;;; DEFVAR and DEFPARAMETER (defmacro-mundanely defvar (var &optional (val nil valp) (doc nil docp)) #!+sb-doc - "For defining global variables at top level. Declares the variable - SPECIAL and, optionally, initializes it. If the variable already has a + "Define a global variable at top level. Declare the variable + SPECIAL and, optionally, initialize it. If the variable already has a value, the old value is not clobbered. The third argument is an optional documentation string for the variable." `(progn @@ -211,10 +257,11 @@ (defmacro-mundanely defparameter (var val &optional (doc nil docp)) #!+sb-doc - "Defines a parameter that is not normally changed by the program, - but that may be changed without causing an error. Declares the - variable special and sets its value to VAL. The third argument is - an optional documentation string for the parameter." + "Define a parameter that is not normally changed by the program, + but that may be changed without causing an error. Declare the + variable special and sets its value to VAL, overwriting any + previous value. The third argument is an optional documentation + string for the parameter." `(progn (declaim (special ,var)) (setq ,var ,val) @@ -227,11 +274,11 @@ ;;;; iteration constructs -;;; (These macros are defined in terms of a function DO-DO-BODY which is also -;;; used by SB!INT:DO-ANONYMOUS. Since these macros should not be loaded -;;; on the cross-compilation host, but SB!INT:DO-ANONYMOUS and DO-DO-BODY -;;; should be, these macros can't conveniently be in the same file as -;;; DO-DO-BODY.) +;;; (These macros are defined in terms of a function DO-DO-BODY which +;;; is also used by SB!INT:DO-ANONYMOUS. Since these macros should not +;;; be loaded on the cross-compilation host, but SB!INT:DO-ANONYMOUS +;;; and DO-DO-BODY should be, these macros can't conveniently be in +;;; the same file as DO-DO-BODY.) (defmacro-mundanely do (varlist endlist &body body) #!+sb-doc "DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form* @@ -255,12 +302,13 @@ allowing RETURN to be used as an laternate exit mechanism." (do-do-body varlist endlist body 'let* 'setq 'do* nil)) -;;; DOTIMES and DOLIST could be defined more concisely using destructuring -;;; macro lambda lists or DESTRUCTURING-BIND, but then it'd be tricky to use -;;; them before those things were defined. They're used enough times before -;;; destructuring mechanisms are defined that it looks as though it's worth -;;; just implementing them ASAP, at the cost of being unable to use the -;;; standard destructuring mechanisms. +;;; DOTIMES and DOLIST could be defined more concisely using +;;; destructuring macro lambda lists or DESTRUCTURING-BIND, but then +;;; it'd be tricky to use them before those things were defined. +;;; They're used enough times before destructuring mechanisms are +;;; defined that it looks as though it's worth just implementing them +;;; ASAP, at the cost of being unable to use the standard +;;; destructuring mechanisms. (defmacro-mundanely dotimes (var-count-result &body body) (multiple-value-bind ; to roll our own destructuring (var count result) @@ -283,13 +331,14 @@ (apply (lambda (var list &optional (result nil)) (values var list result)) var-list-result) - ;; We repeatedly bind the var instead of setting it so that we never have - ;; to give the var an arbitrary value such as NIL (which might conflict - ;; with a declaration). If there is a result form, we introduce a - ;; gratuitous binding of the variable to NIL w/o the declarations, then - ;; evaluate the result form in that environment. We spuriously reference - ;; the gratuitous variable, since we don't want to use IGNORABLE on what - ;; might be a special var. + ;; We repeatedly bind the var instead of setting it so that we + ;; never have to give the var an arbitrary value such as NIL + ;; (which might conflict with a declaration). If there is a result + ;; form, we introduce a gratuitous binding of the variable to NIL + ;; without the declarations, then evaluate the result form in that + ;; environment. We spuriously reference the gratuitous variable, + ;; since since we don't want to use IGNORABLE on what might be a + ;; special var. (let ((n-list (gensym))) `(do ((,n-list ,list (cdr ,n-list))) ((endp ,n-list)