X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefboot.lisp;h=fdec8087a2396789a874494e5b737f364295b8c6;hb=073501ed49414d9638cb41c05fb80627529f796d;hp=48f1497662a53d7761d684bac0b1c69f9e3959f1;hpb=416152f084604094445a758ff399871132dff2bd;p=sbcl.git diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 48f1497..fdec808 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -58,8 +58,8 @@ ((list-of-symbols-p vars) (let ((temps (make-gensym-list (length vars)))) `(multiple-value-bind ,temps ,value-form - ,@(mapcar #'(lambda (var temp) - `(setq ,var ,temp)) + ,@(mapcar (lambda (var temp) + `(setq ,var ,temp)) vars temps) ,(car temps)))) (t (error "Vars is not a list of symbols: ~S" vars)))) @@ -144,7 +144,7 @@ ;;;; DEFUN ;;; Should we save the inline expansion of the function named NAME? -(defun inline-function-name-p (name) +(defun inline-fun-name-p (name) (or ;; the normal reason for saving the inline expansion (info :function :inlinep name) @@ -157,26 +157,30 @@ ;; (DEFUN FOO ..) ;; without a preceding ;; (DECLAIM (INLINE FOO)) - ;; what should we do with the old inline expansion? Overwriting it - ;; with the new definition seems like the only unsurprising choice. - (info :function :inline-expansion name))) + ;; 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 (function-name-block-name name)) + (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* ((lambda `(lambda ,args - ,@decls - (block ,(function-name-block-name name) - ,@forms))) - (want-to-inline ) + (let* (;; stuff shared between LAMBDA and INLINE-LAMBDA and NAMED-LAMBDA + (lambda-guts `(,args + ,@decls + (block ,(fun-name-block-name name) + ,@forms))) + (lambda `(lambda ,@lambda-guts)) + #-sb-xc-host + (named-lambda `(named-lambda ,name ,@lambda-guts)) (inline-lambda (cond (;; Does the user not even want to inline? - (not (inline-function-name-p name)) + (not (inline-fun-name-p name)) nil) (;; Does inlining look too hairy to handle? (not (sb!c:lambda-independent-of-lexenv-p lambda env)) @@ -197,11 +201,16 @@ ;; simplified way. `(sb!c:lambda-with-lexenv nil nil nil ; i.e. no DECLS, no MACROS, no SYMMACS - ,@(rest lambda)))))) + ,@lambda-guts))))) `(progn ;; In cross-compilation of toplevel DEFUNs, we arrange ;; for the LAMBDA to be statically linked by GENESIS. + ;; + ;; It may seem strangely inconsistent not to use NAMED-LAMBDA + ;; here instead of LAMBDA. The reason is historical: + ;; COLD-FSET was written before NAMED-LAMBDA, and has special + ;; logic of its own to notify the compiler about NAME. #+sb-xc-host (cold-fset ,name ,lambda) @@ -213,28 +222,30 @@ ;; where the compiled LAMBDA first appears. In ;; cross-compilation, we manipulate the ;; previously-statically-linked LAMBDA here. - #-sb-xc-host ,lambda + #-sb-xc-host ,named-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 (function-name-block-name name))) - (aver (legal-function-name-p name)) + (aver (legal-fun-name-p name)) (when (fboundp name) - (/show0 "redefining NAME") + (/show0 "redefining NAME in %DEFUN") (style-warn "redefining ~S in DEFUN" name)) - (/show0 "setting FDEFINITION") (setf (sb!xc:fdefinition name) def) + + ;; FIXME: I want to do this here (and fix bug 137), but until the + ;; breathtaking CMU CL function name architecture is converted into + ;; something sane, (1) doing so doesn't really fix the bug, and + ;; (2) doing probably isn't even really safe. + #+nil (setf (%fun-name def) name) + (when doc ;; 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 (the symbol name) 'function) doc))) - (/show0 "leaving %DEFUN") name) ;;;; DEFVAR and DEFPARAMETER @@ -273,11 +284,11 @@ ;;;; iteration constructs -;;; (These macros are defined in terms of a function DO-DO-BODY which +;;; (These macros are defined in terms of a function FROB-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.) +;;; and FROB-DO-BODY should be, these macros can't conveniently be in +;;; the same file as FROB-DO-BODY.) (defmacro-mundanely do (varlist endlist &body body) #!+sb-doc "DO ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form* @@ -288,7 +299,7 @@ are evaluated as a PROGN, with the result being the value of the DO. A block named NIL is established around the entire expansion, allowing RETURN to be used as an alternate exit mechanism." - (do-do-body varlist endlist body 'let 'psetq 'do nil)) + (frob-do-body varlist endlist body 'let 'psetq 'do nil)) (defmacro-mundanely do* (varlist endlist &body body) #!+sb-doc "DO* ({(Var [Init] [Step])}*) (Test Exit-Form*) Declaration* Form* @@ -299,7 +310,7 @@ the Exit-Forms are evaluated as a PROGN, with the result being the value of the DO. A block named NIL is established around the entire expansion, allowing RETURN to be used as an laternate exit mechanism." - (do-do-body varlist endlist body 'let* 'setq 'do* nil)) + (frob-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