X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=73cf75333b8012ff51c35ee1763985c988fd071f;hb=cd176690400f8b6fa23faa4dc6fa8494bcbce480;hp=89c3111b392fa6c7d1d0670ec699b7d7bf2d6f63;hpb=cbaa1997bb097a55d108df592ac3b7eb4a703fff;p=sbcl.git diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 89c3111..73cf753 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -141,68 +141,106 @@ (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* (;; stuff shared between LAMBDA and INLINE-LAMBDA + (lambda-guts `(,args + ,@decls + (block ,(fun-name-block-name name) + ,@forms))) + (lambda `(lambda ,@lambda-guts)) + (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 + ,@lambda-guts))))) + `(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))) + (aver (legal-fun-name-p name)) (when (fboundp name) + (/show0 "redefining NAME in %DEFUN") (style-warn "redefining ~S in DEFUN" name)) (setf (sb!xc:fdefinition name) def) + (setf (%fun-name def) name) (when doc - ;; FIXME: This should use shared SETF-name parsing logic. + ;; FIXME: This should use shared SETF-name-parsing logic. (if (and (consp name) (eq (first name) 'setf)) (setf (fdocumentation (second name) 'setf) doc) - (setf (fdocumentation name 'function) doc))) - (become-defined-function-name name) - (when (or inline-expansion - (info :function :inline-expansion name)) - (setf (info :function :inline-expansion name) - inline-expansion)) + (setf (fdocumentation (the symbol name) 'function) doc))) 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) - (ecase (info :function :where-from name) - (:assumed - (setf (info :function :where-from name) :defined) - (setf (info :function :type name) - (extract-function-type def)) - (when (info :function :assumed-type name) - (setf (info :function :assumed-type name) nil))) - (:declared) - (:defined - (setf (info :function :type name) (extract-function-type def)))) - (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 @@ -216,10 +254,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) @@ -232,11 +271,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* @@ -260,12 +299,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) @@ -288,13 +328,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)