From ae9d491097d99e1851ce8d49fb80d2c8868cde13 Mon Sep 17 00:00:00 2001 From: Douglas Katzman Date: Wed, 1 Feb 2017 15:50:06 -0500 Subject: [PATCH] Remove reader conditionals for #!+sb-doc, part 1 of 3. Automatically nuke docstrings no later than image dump time, or as early as the defining form in cross-compilation. This finds a bunch of accidentally leftover docstrings: * LAMBDA-LIST-KEYWORDS * A few DEFTYPES and DEFINE-CONDITIONS * (METHOD-COMBINATION . NIL) was pushed into random documentation even when no string was provided. * Optimization qualities - not sure if it was deliberate to preserve those docstrings. Let's assume it was not. --- make-target-2-load.lisp | 34 ++++++++++++++++++++++++++++++++++ src/code/condition.lisp | 2 ++ src/code/defboot.lisp | 6 ++++++ src/code/late-extensions.lisp | 4 ++++ src/code/setf.lisp | 2 ++ src/compiler/deftype.lisp | 2 ++ src/compiler/macros.lisp | 6 ++++-- src/compiler/parse-lambda-list.lisp | 2 ++ src/pcl/defcombin.lisp | 3 ++- 9 files changed, 58 insertions(+), 3 deletions(-) diff --git a/make-target-2-load.lisp b/make-target-2-load.lisp index b76b0be2b..26f984978 100644 --- a/make-target-2-load.lisp +++ b/make-target-2-load.lisp @@ -6,6 +6,40 @@ (progn (load "src/cold/warm.lisp") + ;;; Remove docstrings that snuck in, as will happen with + ;;; any file compiled in warm load. + #-sb-doc + (let ((count 0)) + (macrolet ((clear-it (place) + `(when ,place + (setf ,place nil) + (incf count)))) + ;; 1. Functions, macros, special operators + (sb-vm::map-allocated-objects + (lambda (obj type size) + (declare (ignore size)) + (case type + (#.sb-vm:code-header-widetag + (dotimes (i (sb-kernel:code-n-entries obj)) + (let ((f (sb-kernel:%code-entry-point obj i))) + (clear-it (sb-kernel:%simple-fun-doc f))))) + (#.sb-vm:instance-header-widetag + (when (typep obj 'class) + (when (slot-boundp obj 'sb-pcl::%documentation) + (clear-it (slot-value obj 'sb-pcl::%documentation))))) + (#.sb-vm:funcallable-instance-header-widetag + (when (typep obj 'standard-generic-function) + (when (slot-boundp obj 'sb-pcl::%documentation) + (clear-it (slot-value obj 'sb-pcl::%documentation))))))) + :all) + ;; 2. Variables, types, and anything else + (do-all-symbols (s) + (dolist (category '(:variable :type :typed-structure :setf)) + (clear-it (sb-int:info category :documentation s))) + (clear-it (sb-int:info :random-documentation :stuff s)))) + (when (plusp count) + (format t "~&Removed ~D doc string~:P" count))) + ;; Share identical FUN-INFOs sb-int:: (let ((ht (make-hash-table :test 'equalp)) diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 4fc4e6120..0ac648556 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -459,6 +459,8 @@ (t (error "unknown option: ~S" (first option))))) + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq documentation nil) `(progn (eval-when (:compile-toplevel) (%compiler-define-condition ',name ',parent-types ',layout diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 7167661d6..12a491c16 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -184,6 +184,8 @@ evaluated as a PROGN." (unless (symbol-package (fun-name-block-name name)) (warn "DEFUN of uninterned function name ~S (tricky for GENESIS)" name)) (multiple-value-bind (forms decls doc) (parse-body body t) + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) (let* (;; stuff shared between LAMBDA and INLINE-LAMBDA and NAMED-LAMBDA (lambda-guts `(,@decls (block ,(fun-name-block-name name) ,@forms))) (lambda `(lambda ,lambda-list ,@lambda-guts)) @@ -242,6 +244,8 @@ evaluated as a PROGN." 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." + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) `(progn (eval-when (:compile-toplevel) (%compiler-defvar ',var)) @@ -259,6 +263,8 @@ evaluated as a PROGN." variable special and sets its value to VAL, overwriting any previous value. The third argument is an optional documentation string for the parameter." + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) `(progn (eval-when (:compile-toplevel) (%compiler-defvar ',var)) diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp index b4e450cd4..3ffe715f2 100644 --- a/src/code/late-extensions.lisp +++ b/src/code/late-extensions.lisp @@ -95,6 +95,8 @@ locally bound, declared special, defined as constants, and neither bound nor defined as symbol macros. See also the declarations SB-EXT:GLOBAL and SB-EXT:ALWAYS-BOUND." + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) (let ((boundp (make-symbol "BOUNDP"))) `(progn (eval-when (:compile-toplevel) @@ -114,6 +116,8 @@ Attempts to read NAME at compile-time will signal an UNBOUND-VARIABLE error unless it has otherwise been assigned a value. See also DEFGLOBAL which assigns the VALUE at compile-time too." + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) (let ((boundp (make-symbol "BOUNDP"))) `(progn (eval-when (:compile-toplevel) diff --git a/src/code/setf.lisp b/src/code/setf.lisp index ca6688d37..fb0191966 100644 --- a/src/code/setf.lisp +++ b/src/code/setf.lisp @@ -600,6 +600,8 @@ (make-macro-lambda `(setf-expander ,access-fn) lambda-list body 'sb!xc:define-setf-expander access-fn :doc-string-allowed :external) + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) `(eval-when (:compile-toplevel :load-toplevel :execute) (%defsetf ',access-fn ,def ,@(and doc `(,doc)))))) diff --git a/src/compiler/deftype.lisp b/src/compiler/deftype.lisp index 5be211196..9e371eea6 100644 --- a/src/compiler/deftype.lisp +++ b/src/compiler/deftype.lisp @@ -67,6 +67,8 @@ lambda-list body 'deftype name :doc-string-allowed :external :environment :ignore)))) + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) `(progn (eval-when (:compile-toplevel :load-toplevel :execute) (%compiler-deftype ',name ,expander-form ,source-location-form diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index b9348de55..d39467d8a 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -33,7 +33,9 @@ (make-macro-lambda nil lambda-list body :special-form name :doc-string-allowed :external :wrap-block nil))) - (declare (ignorable doc)) + (declare (ignorable doc)) ; unused on host + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq doc nil) `(progn (declaim (ftype (function (ctran ctran (or lvar null) t) (values)) ,fn-name)) @@ -47,7 +49,7 @@ (,lambda-expr ,whole-var *lexenv*) (values)) #-sb-xc-host - (install-guard-function ',name '(:special ,name) ,(or #!+sb-doc doc)) + (install-guard-function ',name '(:special ,name) ,doc) ;; FIXME: Evidently "there can only be one!" -- we overwrite any ;; other :IR1-CONVERT value. This deserves a warning, I think. (setf (info :function :ir1-convert ',name) #',fn-name) diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp index 82b59584f..4c929bb65 100644 --- a/src/compiler/parse-lambda-list.lisp +++ b/src/compiler/parse-lambda-list.lisp @@ -1099,6 +1099,8 @@ (style-warn-once lambda-list "variable ~S occurs more than once" (car tail)))) (append whole env (ds-lambda-list-variables parse nil))) + ;; Maybe kill docstring, but only under the cross-compiler. + #!+(and (not sb-doc) (host-feature sb-xc-host)) (setq docstring nil) (values `(,@(if lambda-name `(named-lambda ,lambda-name) '(lambda)) (,ll-whole ,@ll-env ,@(and ll-aux (cons '&aux ll-aux))) ,@(when (and docstring (eq doc-string-allowed :internal)) diff --git a/src/pcl/defcombin.lisp b/src/pcl/defcombin.lisp index f0f467a3c..8260f26a5 100644 --- a/src/pcl/defcombin.lisp +++ b/src/pcl/defcombin.lisp @@ -97,7 +97,8 @@ (when old-method (remove-method #'find-method-combination old-method)) (add-method #'find-method-combination new-method) - (setf (random-documentation type-name 'method-combination) doc) + (when doc + (setf (random-documentation type-name 'method-combination) doc)) type-name)) (defun short-combine-methods (type-name options operator ioa method doc) -- 2.11.4.GIT