Add (:documentation <form>) for dynamically-generated docstrings

* lisp/emacs-lisp/bytecomp.el:
(byte-compile-initial-macro-environment): Use macroexp-progn.
(byte-compile-cl-warn): Don't silence use of cl-macroexpand-all.
(byte-compile-file-form-defvar-function): Rename from
byte-compile-file-form-define-abbrev-table.
(defvaralias, byte-compile-file-form-custom-declare-variable): Use it.
(byte-compile): Use byte-compile-top-level rather than
byte-compile-lambda so we can compile non-values.
(byte-compile-form): Add warnings for failed uses of lexical vars via
quoted symbols.
(byte-compile-unfold-bcf): Improve message for failed inlining.
(byte-compile-make-closure): Handle new format of internal-make-closure
for dynamically-generated docstrings.

* lisp/emacs-lisp/cconv.el (cconv--convert-function):
Add `docstring' argument.
(cconv-convert): Use it to handle the new (:documentation ...) form.
(cconv-analyze-form): Handle the new (:documentation ...) form.

* src/eval.c (Ffunction): Handle the new (:documentation ...) form.
(syms_of_eval): Declare `:documentation'.

6 files changed, 107 insertions, 33 deletions

diff --git a/etc/NEWS b/etc/NEWS
index 72e23562868..d72d01f233e 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -599,6 +599,10 @@ in languages like German where downcasing rules depend on grammar.
 
 * Lisp Changes in Emacs 25.1
 
+** lexical closures can use (:documentation <form>) to build their docstring.
+It should be placed right where the docstring would be, and <form> is then
+evaluated (and should return a string) when the closure is built.
+
 ** define-inline provides a new way to define inlinable functions.
 
 ** New function macroexpand-1 to perform a single step of macroexpansion.
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 694a35be61d..51e944c9729 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,24 @@
 2015-02-05  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        * emacs-lisp/cconv.el (cconv--convert-function):
+        Add `docstring' argument.
+        (cconv-convert): Use it to handle the new (:documentation ...) form.
+        (cconv-analyze-form): Handle the new (:documentation ...) form.
+
+        * emacs-lisp/bytecomp.el:
+        (byte-compile-initial-macro-environment): Use macroexp-progn.
+        (byte-compile-cl-warn): Don't silence use of cl-macroexpand-all.
+        (byte-compile-file-form-defvar-function): Rename from
+        byte-compile-file-form-define-abbrev-table.
+        (defvaralias, byte-compile-file-form-custom-declare-variable): Use it.
+        (byte-compile): Use byte-compile-top-level rather than
+        byte-compile-lambda so we can compile non-values.
+        (byte-compile-form): Add warnings for failed uses of lexical vars via
+        quoted symbols.
+        (byte-compile-unfold-bcf): Improve message for failed inlining.
+        (byte-compile-make-closure): Handle new format of internal-make-closure
+        for dynamically-generated docstrings.
+
         * delsel.el: Deprecate the `kill' option.  Use lexical-binding.
         (open-line): Delete like all other commands, instead of killing.
         (delete-active-region): Don't define any return any value.
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 2bd8d07851b..548aaa9626b 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -31,6 +31,10 @@
 ;; faster.  [`LAP' == `Lisp Assembly Program'.]
 ;; The user entry points are byte-compile-file and byte-recompile-directory.
 
+;;; Todo:
+
+;; - Turn "not bound at runtime" functions into autoloads.
+
 ;;; Code:
 
 ;; ========================================================================
@@ -450,7 +454,7 @@ Return the compile-time value of FORM."
     (eval-when-compile . ,(lambda (&rest body)
                             (let ((result nil))
                               (byte-compile-recurse-toplevel
-                               (cons 'progn body)
+                               (macroexp-progn body)
                                (lambda (form)
                                  (setf result
                                        (byte-compile-eval
@@ -459,7 +463,7 @@ Return the compile-time value of FORM."
                               (list 'quote result))))
     (eval-and-compile . ,(lambda (&rest body)
                            (byte-compile-recurse-toplevel
-                            (cons 'progn body)
+                            (macroexp-progn body)
                             (lambda (form)
                               ;; Don't compile here, since we don't know
                               ;; whether to compile as byte-compile-form
@@ -1458,7 +1462,7 @@ extra args."
                           ;; These would sometimes be warned about
                           ;; but such warnings are never useful,
                           ;; so don't warn about them.
-                          macroexpand cl-macroexpand-all
+                          macroexpand
                           cl--compiling-file))))
         (byte-compile-warn "function `%s' from cl package called at runtime"
                            func)))
@@ -2319,10 +2323,12 @@ list that represents a doc string reference.
     form))
 
 (put 'define-abbrev-table 'byte-hunk-handler
-     'byte-compile-file-form-define-abbrev-table)
-(defun byte-compile-file-form-define-abbrev-table (form)
-  (if (eq 'quote (car-safe (car-safe (cdr form))))
-      (byte-compile--declare-var (car-safe (cdr (cadr form)))))
+     'byte-compile-file-form-defvar-function)
+(put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function)
+
+(defun byte-compile-file-form-defvar-function (form)
+  (pcase-let (((or `',name (let name nil)) (nth 1 form)))
+    (if name (byte-compile--declare-var name)))
   (byte-compile-keep-pending form))
 
 (put 'custom-declare-variable 'byte-hunk-handler
@@ -2330,8 +2336,7 @@ list that represents a doc string reference.
 (defun byte-compile-file-form-custom-declare-variable (form)
   (when (byte-compile-warning-enabled-p 'callargs)
     (byte-compile-nogroup-warn form))
-  (byte-compile--declare-var (nth 1 (nth 1 form)))
-  (byte-compile-keep-pending form))
+  (byte-compile-file-form-defvar-function form))
 
 (put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
 (defun byte-compile-file-form-require (form)
@@ -2580,17 +2585,11 @@ If FORM is a lambda or a macro, byte-compile it as a function."
         fun)
        (t
         (when (symbolp form)
-          (unless (memq (car-safe fun) '(closure lambda))
-            (error "Don't know how to compile %S" fun))
           (setq lexical-binding (eq (car fun) 'closure))
           (setq fun (byte-compile--reify-function fun)))
-        (unless (eq (car-safe fun) 'lambda)
-          (error "Don't know how to compile %S" fun))
         ;; Expand macros.
         (setq fun (byte-compile-preprocess fun))
-        ;; Get rid of the `function' quote added by the `lambda' macro.
-        (if (eq (car-safe fun) 'function) (setq fun (cadr fun)))
-        (setq fun (byte-compile-lambda fun))
+        (setq fun (byte-compile-top-level fun nil 'eval))
         (if macro (push 'macro fun))
         (if (symbolp form)
             (fset form fun)
@@ -2966,6 +2965,16 @@ for symbols generated by the byte compiler itself."
              (interactive-only
               (or (get fn 'interactive-only)
                   (memq fn byte-compile-interactive-only-functions))))
+        (when (memq fn '(set symbol-value run-hooks ;; add-to-list
+                             add-hook remove-hook run-hook-with-args
+                             run-hook-with-args-until-success
+                             run-hook-with-args-until-failure))
+          (pcase (cdr form)
+            (`(',var . ,_)
+             (when (assq var byte-compile-lexical-variables)
+               (byte-compile-log-warning
+                (format "%s cannot use lexical var `%s'" fn var)
+                nil :error)))))
         (when (macroexp--const-symbol-p fn)
           (byte-compile-warn "`%s' called as a function" fn))
         (when (and (byte-compile-warning-enabled-p 'interactive-only)
@@ -3079,8 +3088,9 @@ for symbols generated by the byte compiler itself."
       (dotimes (_ (- (/ (1+ fmax2) 2) alen))
         (byte-compile-push-constant nil)))
      ((zerop (logand fmax2 1))
-      (byte-compile-log-warning "Too many arguments for inlined function"
-                                nil :error)
+      (byte-compile-log-warning
+       (format "Too many arguments for inlined function %S" form)
+       nil :error)
       (byte-compile-discard (- alen (/ fmax2 2))))
      (t
       ;; Turn &rest args into a list.
@@ -3453,15 +3463,22 @@ discarding."
   (if byte-compile--for-effect (setq byte-compile--for-effect nil)
     (let* ((vars (nth 1 form))
            (env (nth 2 form))
-           (body (nthcdr 3 form))
+           (docstring-exp (nth 3 form))
+           (body (nthcdr 4 form))
            (fun
             (byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
-      (cl-assert (> (length env) 0))       ;Otherwise, we don't need a closure.
+      (cl-assert (or (> (length env) 0)
+                     docstring-exp))    ;Otherwise, we don't need a closure.
       (cl-assert (byte-code-function-p fun))
       (byte-compile-form `(make-byte-code
                            ',(aref fun 0) ',(aref fun 1)
                            (vconcat (vector . ,env) ',(aref fun 2))
-                           ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun)))))))
+                           ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
+                               (if docstring-exp
+                                   `(,(car rest)
+                                     ,docstring-exp
+                                     ,@(cddr rest))
+                                 rest)))))))
 
 (defun byte-compile-get-closed-var (form)
   "Byte-compile the special `internal-get-closed-var' form."
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index e9d33e6c646..fa824075933 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -48,7 +48,7 @@
 ;; if the function is suitable for lambda lifting (if all calls are known)
 ;;
 ;; (lambda (v0 ...) ... fv0 .. fv1 ...)  =>
-;; (internal-make-closure (v0 ...) (fv1 ...)
+;; (internal-make-closure (v0 ...) (fv0 ...) <doc>
 ;;   ... (internal-get-closed-var 0) ...  (internal-get-closed-var 1) ...)
 ;;
 ;; If the function has no free variables, we don't do anything.
@@ -65,6 +65,14 @@
 ;;
 ;;; Code:
 
+;; PROBLEM cases found during conversion to lexical binding.
+;; We should try and detect and warn about those cases, even
+;; for lexical-binding==nil to help prepare the migration.
+;; - Uses of run-hooks, and friends.
+;; - Cases where we want to apply the same code to different vars depending on
+;;   some test.  These sometimes use a (let ((foo (if bar 'a 'b)))
+;;   ... (symbol-value foo) ... (set foo ...)).
+
 ;; TODO: (not just for cconv but also for the lexbind changes in general)
 ;; - let (e)debug find the value of lexical variables from the stack.
 ;; - make eval-region do the eval-sexp-add-defvars dance.
@@ -87,9 +95,8 @@
 ;;   the bytecomp only compiles it once.
 ;; - Since we know here when a variable is not mutated, we could pass that
 ;;   info to the byte-compiler, e.g. by using a new `immutable-let'.
-;; - add tail-calls to bytecode.c and the byte compiler.
 ;; - call known non-escaping functions with `goto' rather than `call'.
-;; - optimize mapcar to a while loop.
+;; - optimize mapc to a dolist loop.
 
 ;; (defmacro dlet (binders &rest body)
 ;;   ;; Works in both lexical and non-lexical mode.
@@ -195,7 +202,7 @@ Returns a form where all lambdas don't have any free variables."
       (unless (memq (car b) s) (push b res)))
     (nreverse res)))
 
-(defun cconv--convert-function (args body env parentform)
+(defun cconv--convert-function (args body env parentform &optional docstring)
   (cl-assert (equal body (caar cconv-freevars-alist)))
   (let* ((fvs (cdr (pop cconv-freevars-alist)))
          (body-new '())
@@ -240,11 +247,11 @@ Returns a form where all lambdas don't have any free variables."
               `(,@(nreverse special-forms) (let ,letbind . ,body-new)))))
 
     (cond
-     ((null envector)                   ;if no freevars - do nothing
+     ((not (or envector docstring))     ;If no freevars - do nothing.
       `(function (lambda ,args . ,body-new)))
      (t
       `(internal-make-closure
-        ,args ,envector . ,body-new)))))
+        ,args ,envector ,docstring . ,body-new)))))
 
 (defun cconv-convert (form env extend)
   ;; This function actually rewrites the tree.
@@ -407,7 +414,9 @@ places where they originally did not directly appear."
                        cond-forms)))
 
     (`(function (lambda ,args . ,body) . ,_)
-     (cconv--convert-function args body env form))
+     (let ((docstring (if (eq :documentation (car-safe (car body)))
+                          (cconv-convert (cadr (pop body)) env extend))))
+       (cconv--convert-function args body env form docstring)))
 
     (`(internal-make-closure . ,_)
      (byte-compile-report-error
@@ -533,7 +542,7 @@ FORM is the parent form that binds this var."
   ;; use = `(,binder ,read ,mutated ,captured ,called)
   (pcase vardata
     (`(,_ nil nil nil nil) nil)
-    (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_)
+    (`((,(and var (guard (eq ?_ (aref (symbol-name var) 0)))) . ,_)
        ,_ ,_ ,_ ,_)
      (byte-compile-log-warning
       (format "%s `%S' not left unused" varkind var))))
@@ -643,6 +652,8 @@ and updates the data stored in ENV."
          (cconv--analyze-use vardata form "variable"))))
 
     (`(function (lambda ,vrs . ,body-forms))
+     (when (eq :documentation (car-safe (car body-forms)))
+       (cconv-analyze-form (cadr (pop body-forms)) env))
      (cconv--analyze-function vrs body-forms env form))
 
     (`(setq . ,forms)
@@ -665,6 +676,10 @@ and updates the data stored in ENV."
      (dolist (forms cond-forms)
        (dolist (form forms) (cconv-analyze-form form env))))
 
+    ;; ((and `(quote ,v . ,_) (guard (assq v env)))
+    ;;  (byte-compile-log-warning
+    ;;   (format "Possible confusion variable/symbol for `%S'" v)))
+
     (`(quote . ,_) nil)                 ; quote form
     (`(function . ,_) nil)              ; same as quote
 
diff --git a/src/ChangeLog b/src/ChangeLog
index 2c9b6c8375b..15d8d27a921 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2015-02-05  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * eval.c (Ffunction): Handle the new (:documentation ...) form.
+        (syms_of_eval): Declare `:documentation'.
+
 2015-02-05  Martin Rudalics  <rudalics@gmx.at>
 
         * xdisp.c (Fwindow_text_pixel_size): Remove optional BUFFER
diff --git a/src/eval.c b/src/eval.c
index b98b224e622..e828da9288f 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -575,10 +575,23 @@ usage: (function ARG)  */)
   if (!NILP (Vinternal_interpreter_environment)
       && CONSP (quoted)
       && EQ (XCAR (quoted), Qlambda))
-    /* This is a lambda expression within a lexical environment;
-       return an interpreted closure instead of a simple lambda.  */
-    return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
-                                   XCDR (quoted)));
+    { /* This is a lambda expression within a lexical environment;
+         return an interpreted closure instead of a simple lambda.  */
+      Lisp_Object cdr = XCDR (quoted);
+      Lisp_Object tmp = cdr;
+      if (CONSP (tmp)
+          && (tmp = XCDR (tmp), CONSP (tmp))
+          && (tmp = XCAR (tmp), CONSP (tmp))
+          && (EQ (QCdocumentation, XCAR (tmp))))
+        { /* Handle the special (:documentation <form>) to build the docstring
+             dynamically.  */
+          Lisp_Object docstring = eval_sub (Fcar (XCDR (tmp)));
+          CHECK_STRING (docstring);
+          cdr = Fcons (XCAR (cdr), Fcons (docstring, XCDR (XCDR (cdr))));
+        }
+      return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment,
+                                     cdr));
+    }
   else
     /* Simply quote the argument.  */
     return quoted;
@@ -3668,6 +3681,7 @@ before making `inhibit-quit' nil.  */);
   DEFSYM (Qand_rest, "&rest");
   DEFSYM (Qand_optional, "&optional");
   DEFSYM (Qclosure, "closure");
+  DEFSYM (QCdocumentation, ":documentation");
   DEFSYM (Qdebug, "debug");
 
   DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,