Re: bug#24514: 24.5; Lispy backtraces

Re: bug#24514: 24.5; Lispy backtraces

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 2122 bytes --]

Hi emacs-devel,

The discussion below seems to indicate that there's very little missing at the Lisp level to be able to implement `backtrace' in Lisp; is that right?

The documentation for backtrace states:

     It is written in C, since it must have
     access to the stack to determine which function calls are active.
     The return value is always ‘nil’.

But the existence of backtrace-frame seems to (partially) contradict this; or am I misunderstanding?

The context is that I need to capture backtraces on an Emacs server, and that I have no way (AFAICT) to know, when my debugger gets invoked, whether the error will then be handled by a condition-case block; thus I end up recording too much and my program ends up spending 95% of its time capturing useless backtraces.  

Instead, recording a sequence of backtrace-frame seems fast (thanks Vasilij!).  But then, if an unhandled exception occurs, I need to actually format the recorded stack frames; which seems to be what `backtrace' does, only at the C level.

Cheers
Clément. 

On 2016-12-01 19:52, Vasilij Schneidermann wrote:
>> Thinking more about this, isn't this enough to implement `backtrace' in Lisp?
> 
> Not quite.  If you look at backtraces, you'll notice they are constantly
> prefixed with two spaces.  This prefix is conditional and can be
> replaced with an asterisk and a space to indicate where you currently
> are when stepping through the backtrace.  From what I can tell, there is
> no way to retrieve that information when relying on `backtrace-frame'
> only.
> 
> If you ignore that part, it's not too hard to write a replacement:
> 
> (with-output-to-string
>   (let ((print-level (or print-level 8))
>         (i 0)
>         frame)
>     (while (setq frame (backtrace-frame i))
>       (princ "  ")
>       (if (not (car frame))
>           (prin1 (cdr frame))
>         (prin1 (cadr frame))
>         (prin1 (cddr frame)))
>       (terpri)
>       (setq i (1+ i)))))
> 
> How faithful that one is, I don't know.  Perhaps this is a discussion better
> held on emacs-devel?
> 


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: bug#24514: 24.5; Lispy backtraces

[Stefan Monnier]

> The discussion below seems to indicate that there's very little missing at
> the Lisp level to be able to implement `backtrace' in Lisp; is that right?

Indeed, I think all the info needed is provided by backtrace-frame.


        Stefan

Re: bug#24514: 24.5; Lispy backtraces

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 565 bytes --]

On 2016-12-01 21:24, Stefan Monnier wrote:
>> The discussion below seems to indicate that there's very little missing at
>> the Lisp level to be able to implement `backtrace' in Lisp; is that right?
> 
> Indeed, I think all the info needed is provided by backtrace-frame.

The C implementation of backtrace-frame seems to be linear in the index of the requested frame, so a Lisp implementation of backtrace would be quadratic in the depth of the stack trace.  Would a new function backtrace-frames that returns all frames at once be acceptable?

Clément


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: bug#24514: 24.5; Lispy backtraces

[Eli Zaretskii]

> From: Clément Pit--Claudel <clement.pit@gmail.com>
> Date: Sat, 3 Dec 2016 17:15:22 -0500
> 
> On 2016-12-01 21:24, Stefan Monnier wrote:
> >> The discussion below seems to indicate that there's very little missing at
> >> the Lisp level to be able to implement `backtrace' in Lisp; is that right?
> > 
> > Indeed, I think all the info needed is provided by backtrace-frame.
> 
> The C implementation of backtrace-frame seems to be linear in the index of the requested frame, so a Lisp implementation of backtrace would be quadratic in the depth of the stack trace.  Would a new function backtrace-frames that returns all frames at once be acceptable?

But such a backtrace-frames function would have to be implemented in
C, right?  And you wanted to move the implementation of "backtrace" to
Lisp, AFAIU.  So it sounds like we will be replacing one C primitive
with another, or did I miss something?

Re: bug#24514: 24.5; Lispy backtraces

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 1264 bytes --]

On 2016-12-04 10:30, Eli Zaretskii wrote:
>> From: Clément Pit--Claudel <clement.pit@gmail.com>
>> Date: Sat, 3 Dec 2016 17:15:22 -0500
>>
>> On 2016-12-01 21:24, Stefan Monnier wrote:
>>>> The discussion below seems to indicate that there's very little missing at
>>>> the Lisp level to be able to implement `backtrace' in Lisp; is that right?
>>>
>>> Indeed, I think all the info needed is provided by backtrace-frame.
>>
>> The C implementation of backtrace-frame seems to be linear in the index of the requested frame, so a Lisp implementation of backtrace would be quadratic in the depth of the stack trace.  Would a new function backtrace-frames that returns all frames at once be acceptable?
> 
> But such a backtrace-frames function would have to be implemented in
> C, right?  And you wanted to move the implementation of "backtrace" to
> Lisp, AFAIU.  So it sounds like we will be replacing one C primitive
> with another, or did I miss something?

I think you're correct. It would seem good to have the flexible primitive backtrace-frames available, and it must be in C; then we can move backtrace itself to lisp.

The idea is that enumerating frames must be done in C, but printing them doesn't need to be done there.

Clément.


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: bug#24514: 24.5; Lispy backtraces

[Eli Zaretskii]

> Cc: emacs-devel@gnu.org
> From: Clément Pit--Claudel <clement.pit@gmail.com>
> Date: Sun, 4 Dec 2016 14:27:59 -0500
> 
> >> The C implementation of backtrace-frame seems to be linear in the index of the requested frame, so a Lisp implementation of backtrace would be quadratic in the depth of the stack trace.  Would a new function backtrace-frames that returns all frames at once be acceptable?
> > 
> > But such a backtrace-frames function would have to be implemented in
> > C, right?  And you wanted to move the implementation of "backtrace" to
> > Lisp, AFAIU.  So it sounds like we will be replacing one C primitive
> > with another, or did I miss something?
> 
> I think you're correct. It would seem good to have the flexible primitive backtrace-frames available, and it must be in C; then we can move backtrace itself to lisp.
> 
> The idea is that enumerating frames must be done in C, but printing them doesn't need to be done there.

So would it perhaps make sense to rename 'backtrace' into something
like 'backtrace--internal', and make it accept one more argument, the
function to apply to each frame, which is now hard-coded as 'prin1'?
Would that allow you to implement 'backtrace' in Lisp and also
implement whatever application you had in mind, by calling
'backtrace--internal' passing it your own function instead of 'prin1'?

Re: bug#24514: 24.5; Lispy backtraces

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 1931 bytes --]

On 2016-12-04 15:41, Eli Zaretskii wrote:
>> Cc: emacs-devel@gnu.org
>> From: Clément Pit--Claudel <clement.pit@gmail.com>
>> Date: Sun, 4 Dec 2016 14:27:59 -0500
>>
>>>> The C implementation of backtrace-frame seems to be linear in the index of the requested frame, so a Lisp implementation of backtrace would be quadratic in the depth of the stack trace.  Would a new function backtrace-frames that returns all frames at once be acceptable?
>>>
>>> But such a backtrace-frames function would have to be implemented in
>>> C, right?  And you wanted to move the implementation of "backtrace" to
>>> Lisp, AFAIU.  So it sounds like we will be replacing one C primitive
>>> with another, or did I miss something?
>>
>> I think you're correct. It would seem good to have the flexible primitive backtrace-frames available, and it must be in C; then we can move backtrace itself to lisp.
>>
>> The idea is that enumerating frames must be done in C, but printing them doesn't need to be done there.
> 
> So would it perhaps make sense to rename 'backtrace' into something
> like 'backtrace--internal', and make it accept one more argument, the
> function to apply to each frame, which is now hard-coded as 'prin1'?
> Would that allow you to implement 'backtrace' in Lisp and also
> implement whatever application you had in mind, by calling
> 'backtrace--internal' passing it your own function instead of 'prin1'?

Quite possibly! Are you worried about the cost of allocating a list containing all frames? 
IN any case, that would be consistent with the style of maphash, for example. And a variant of backtrace taking a callback would definitely make backtrace-frames easy to implement on the lisp side :)

There's no big hurry on this, anyway: it's just that we recently added a neat option to backtrace, and there were mentions of making the backtrace buffer more useful in various ways, too.

Clément.


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: bug#24514: 24.5; Lispy backtraces

[Eli Zaretskii]

> Cc: emacs-devel@gnu.org
> From: Clément Pit--Claudel <clement.pit@gmail.com>
> Date: Sun, 4 Dec 2016 17:14:38 -0500
> 
> > So would it perhaps make sense to rename 'backtrace' into something
> > like 'backtrace--internal', and make it accept one more argument, the
> > function to apply to each frame, which is now hard-coded as 'prin1'?
> > Would that allow you to implement 'backtrace' in Lisp and also
> > implement whatever application you had in mind, by calling
> > 'backtrace--internal' passing it your own function instead of 'prin1'?
> 
> Quite possibly! Are you worried about the cost of allocating a list containing all frames? 

No, I'm not worried about that.

> a variant of backtrace taking a callback would definitely make backtrace-frames easy to implement on the lisp side :)

Yup.

> There's no big hurry on this, anyway: it's just that we recently added a neat option to backtrace, and there were mentions of making the backtrace buffer more useful in various ways, too.

Will you be working on this idea at some point?

Lisp-friendly backtraces [was: Lispy backtraces]

[Clément Pit--Claudel]

[-- Attachment #1.1.1: Type: text/plain, Size: 1035 bytes --]

On 2016-12-04 22:30, Eli Zaretskii wrote:
>>> So would it perhaps make sense to rename 'backtrace' into something
>>> like 'backtrace--internal', and make it accept one more argument, the
>>> function to apply to each frame, which is now hard-coded as 'prin1'?
>>> Would that allow you to implement 'backtrace' in Lisp and also
>>> implement whatever application you had in mind, by calling
>>> 'backtrace--internal' passing it your own function instead of 'prin1'?
>>
>> Quite possibly!
>
> Will you be working on this idea at some point?

Yup.  I've attached a rough patch, and an ELisp file showing what calling the new function (mapbacktrace) looks like.

Let me know if this direction makes sense.  If so, I will write the corresponding documentation, a Changelog entry, and a proper commit message.

(CC Alan, since you recently expressed frustration with the contents of the *Backtrace* buffer; hopefully this new function will help with implementing a more flexible *Backtrace* buffer?)

Cheers,
Clément.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: 0001-New-function-mapbacktrace.patch --]
[-- Type: text/x-diff; name="0001-New-function-mapbacktrace.patch", Size: 2753 bytes --]

From 861c841eb242c474c66421ce4d9964940033ff31 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] New function mapbacktrace

---
 src/eval.c | 50 +++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 49 insertions(+), 1 deletion(-)

diff --git a/src/eval.c b/src/eval.c
index 724f001..dcda51c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3420,6 +3420,53 @@ The debugger is entered when that frame exits, if the flag is non-nil.  */)
   return flag;
 }
 
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+       doc: /* Call FUNCTION for each frame in backtrace.
+FUNCTION is called with 4 arguments EVALD FUNC ARGS FLAGS.  If a frame
+has not evaluated its arguments yet or is a special form, EVALD is nil
+and ARGS is a list of forms.  If a frame has evaluated its arguments
+and called its function already, EVALD is t and ARGS is a list of
+values.  FLAGS is a plist of properties of the current frame:
+currently, the only supported property is :debug-on-exit.
+If NSKIP is non-nil, the top NSKIP frames are skipped.
+`mapbacktrace' always returns nil.  */)
+     (Lisp_Object function, Lisp_Object nskip)
+{
+  union specbinding *pdl = backtrace_top ();
+
+  if (!NILP (nskip))
+    {
+      CHECK_NUMBER(nskip);
+      EMACS_INT to_skip = XINT(nskip);
+      while (to_skip > 0 && backtrace_p (pdl)) {
+        to_skip--;
+        pdl = backtrace_next (pdl);
+      }
+    }
+
+  while (backtrace_p (pdl))
+    {
+      Lisp_Object flags = Qnil;
+      if (backtrace_debug_on_exit (pdl))
+        {
+          flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+        }
+
+      if (backtrace_nargs (pdl) == UNEVALLED)
+        {
+          call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
+        }
+      else
+        {
+          Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+          call4 (function, Qt, backtrace_function (pdl), tem, flags);
+        }
+      pdl = backtrace_next (pdl);
+    }
+
+  return Qnil;
+}
+
 DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
        doc: /* Print a trace of Lisp function calls currently active.
 Output stream used is value of `standard-output'.  */)
@@ -3973,7 +4020,8 @@ alist of active lexical bindings.  */);
   defsubr (&Srun_hook_wrapped);
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
-  defsubr (&Sbacktrace);
+  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  defsubr (&Smapbacktrace);
   defsubr (&Sbacktrace_frame);
   defsubr (&Sbacktrace_eval);
   defsubr (&Sbacktrace__locals);
-- 
2.7.4


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.3: bt.el --]
[-- Type: text/x-emacs-lisp; name="bt.el", Size: 1931 bytes --]

;; -*- lexical-binding: t -*-

(defun backtrace-1 (evald func args flags)
  "Print a trace of a single stack frame to `standard-output'.
EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
  (let ((print-level (or print-level 8)))
    (princ (if (plist-get flags :debug-on-exit) "* " "  "))
    (cond
     ((and evald (not debugger-stack-frame-as-list))
      (prin1 func)
      (if args (prin1 args) (princ "()")))
     (t
      (prin1 (cons func args))))
    (princ "\n")))

(defun backtrace ()
  "Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'."
  (mapbacktrace #'~/backtrace-1 1))

(defun backtrace-frames ()
  "Collect all frames of current backtrace into a list."
  (let ((frames nil))
    (mapbacktrace (lambda (&rest frame) (push frame frames)) 2)
    (nreverse frames)))

(defun ~/backtrace-frame (nframes &optional base)
  "Return the function and arguments NFRAMES up from current execution point.
If that frame has not evaluated the arguments yet (or is a special form),
the value is (nil FUNCTION ARG-FORMS...).
If that frame has evaluated its arguments and called its function already,
the value is (t FUNCTION ARG-VALUES...).
A &rest arg is represented as the tail of the list ARG-VALUES.
FUNCTION is whatever was supplied as car of evaluated list,
or a lambda expression for macro calls.
If NFRAMES is more than the number of frames, the value is nil.
If BASE is non-nil, it should be a function and NFRAMES counts from its
nearest activation frame."
  (let ((frame nil))
    (mapbacktrace (lambda (evald func args _)
                    (when (and base (eq func base))
                      (setq base nil))
                    (unless base
                      (when (eq nframes 0)
                        (setq frame `(,evald ,func ,@args)))
                      (setq nframes (1- nframes)))))
    frame))

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Stefan Monnier]

> +  if (!NILP (nskip))
> +    {
> +      CHECK_NUMBER(nskip);
                    ^^
Please put a space before every open paren.

> +      EMACS_INT to_skip = XINT(nskip);
> +      while (to_skip > 0 && backtrace_p (pdl)) {
> +        to_skip--;
> +        pdl = backtrace_next (pdl);
> +      }
> +    }

Why not use the same `base` arg as `backtrace-frame` instead of `nskip`?

> -  defsubr (&Sbacktrace);
> +  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
> +  defsubr (&Smapbacktrace);

You remove the defsubr of Sbacktrace, but you don't remove the
corresponding DEFUN.

> (defun backtrace ()
>   "Print a trace of Lisp function calls currently active.
> Output stream used is value of `standard-output'."
>   (mapbacktrace #'~/backtrace-1 1))

Have you tried it both byte-compiled and interpreted?  Maybe this
function is just simple enough that the result is the same in both
cases, but in my experience, the stack is sufficiently different in the
two cases that a constant nskip doesn't cut it (hence the use of `base`
in backtrace-frame).


        Stefan

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Clément Pit--Claudel]

[-- Attachment #1.1.1: Type: text/plain, Size: 692 bytes --]

On 2016-12-05 08:20, Stefan Monnier wrote:
>> (defun backtrace ()
>>   "Print a trace of Lisp function calls currently active.
>> Output stream used is value of `standard-output'."
>>   (mapbacktrace #'~/backtrace-1 1))
> 
> Have you tried it both byte-compiled and interpreted?  Maybe this
> function is just simple enough that the result is the same in both
> cases, but in my experience, the stack is sufficiently different in the
> two cases that a constant nskip doesn't cut it (hence the use of `base`
> in backtrace-frame).

Thanks; I attached an updated patch.  Removing `backtrace' from eval.c makes the patch much harder to read, so I'll do that later.

Clément.



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: bt.el --]
[-- Type: text/x-emacs-lisp; name="bt.el", Size: 2029 bytes --]

;; -*- lexical-binding: t -*-

(defun backtrace-1 (evald func args flags)
  "Print a trace of a single stack frame to `standard-output'.
EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
  (let ((print-level (or print-level 8)))
    (princ (if (plist-get flags :debug-on-exit) "* " "  "))
    (cond
     ((and evald (not debugger-stack-frame-as-list))
      (prin1 func)
      (if args (prin1 args) (princ "()")))
     (t
      (prin1 (cons func args))))
    (princ "\n")))

(defun backtrace ()
  "Print a trace of Lisp function calls currently active.
Output stream used is value of `standard-output'."
  (mapbacktrace #'backtrace-1 'backtrace))

(backtrace)

(defun backtrace-frames ()
  "Collect all frames of current backtrace into a list."
  (let ((frames nil))
    (mapbacktrace (lambda (&rest frame) (push frame frames)) 'backtrace-frames)
    (nreverse frames)))

(backtrace-frames)

(defun ~/backtrace-frame (nframes &optional base)
  "Return the function and arguments NFRAMES up from current execution point.
If that frame has not evaluated the arguments yet (or is a special form),
the value is (nil FUNCTION ARG-FORMS...).
If that frame has evaluated its arguments and called its function already,
the value is (t FUNCTION ARG-VALUES...).
A &rest arg is represented as the tail of the list ARG-VALUES.
FUNCTION is whatever was supplied as car of evaluated list,
or a lambda expression for macro calls.
If NFRAMES is more than the number of frames, the value is nil.
If BASE is non-nil, it should be a function and NFRAMES counts from its
nearest activation frame."
  (let ((frame nil))
    (mapbacktrace (lambda (evald func args _)
                    (when (and base (eq func base))
                      (setq base nil))
                    (unless base
                      (when (eq nframes 0)
                        (setq frame `(,evald ,func ,@args)))
                      (setq nframes (1- nframes))))
                  '~/backtrace-frame)
    frame))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.3: 0001-New-function-mapbacktrace.patch --]
[-- Type: text/x-diff; name="0001-New-function-mapbacktrace.patch", Size: 3683 bytes --]

From 6302757b6fc664a8ef56ff8742aaf1987e58107d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] New function mapbacktrace

---
 src/eval.c | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 57 insertions(+), 9 deletions(-)

diff --git a/src/eval.c b/src/eval.c
index 724f001..66b665e 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3420,6 +3420,60 @@ The debugger is entered when that frame exits, if the flag is non-nil.  */)
   return flag;
 }
 
+static union specbinding *
+get_backtrace_starting_at (Lisp_Object base)
+{
+  union specbinding *pdl = backtrace_top ();
+
+  if (!NILP (base))
+    { /* Skip up to `base'.  */
+      base = Findirect_function (base, Qt);
+      while (backtrace_p (pdl)
+             && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+        pdl = backtrace_next (pdl);
+    }
+
+  return pdl;
+}
+
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+       doc: /* Call FUNCTION for each frame in backtrace.
+FUNCTION is called with 4 arguments EVALD FUNC ARGS FLAGS.  If a frame
+has not evaluated its arguments yet or is a special form, EVALD is nil
+and ARGS is a list of forms.  If a frame has evaluated its arguments
+and called its function already, EVALD is t and ARGS is a list of
+values.  FLAGS is a plist of properties of the current frame:
+currently, the only supported property is :debug-on-exit.
+If BASE is non-nil, it should be a function and iteration will start
+from its nearest activation frame.
+`mapbacktrace' always returns nil.  */)
+     (Lisp_Object function, Lisp_Object base)
+{
+  union specbinding *pdl = get_backtrace_starting_at (base);
+
+  while (backtrace_p (pdl))
+    {
+      Lisp_Object flags = Qnil;
+      if (backtrace_debug_on_exit (pdl))
+        {
+          flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+        }
+
+      if (backtrace_nargs (pdl) == UNEVALLED)
+        {
+          call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
+        }
+      else
+        {
+          Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+          call4 (function, Qt, backtrace_function (pdl), tem, flags);
+        }
+      pdl = backtrace_next (pdl);
+    }
+
+  return Qnil;
+}
+
 DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
        doc: /* Print a trace of Lisp function calls currently active.
 Output stream used is value of `standard-output'.  */)
@@ -3470,18 +3524,10 @@ Output stream used is value of `standard-output'.  */)
 static union specbinding *
 get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
 {
-  union specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NATNUM (nframes);
-
-  if (!NILP (base))
-    { /* Skip up to `base'.  */
-      base = Findirect_function (base, Qt);
-      while (backtrace_p (pdl)
-	     && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
-	pdl = backtrace_next (pdl);
-    }
+  union specbinding *pdl = get_backtrace_starting_at (base);
 
   /* Find the frame requested.  */
   for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
@@ -3974,6 +4020,8 @@ alist of active lexical bindings.  */);
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
   defsubr (&Sbacktrace);
+  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  defsubr (&Smapbacktrace);
   defsubr (&Sbacktrace_frame);
   defsubr (&Sbacktrace_eval);
   defsubr (&Sbacktrace__locals);
-- 
2.7.4


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Stefan Monnier]

> Removing `backtrace' from eval.c makes the patch much harder to read,
> so I'll do that later.

M-x diff-unified->context RET

should solve this apparent problem.


        Stefan

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Eli Zaretskii]

> From: Clément Pit--Claudel <clement.pit@gmail.com>
> Date: Mon, 5 Dec 2016 09:14:38 -0500
> 
> On 2016-12-05 08:20, Stefan Monnier wrote:
> >> (defun backtrace ()
> >>   "Print a trace of Lisp function calls currently active.
> >> Output stream used is value of `standard-output'."
> >>   (mapbacktrace #'~/backtrace-1 1))
> > 
> > Have you tried it both byte-compiled and interpreted?  Maybe this
> > function is just simple enough that the result is the same in both
> > cases, but in my experience, the stack is sufficiently different in the
> > two cases that a constant nskip doesn't cut it (hence the use of `base`
> > in backtrace-frame).
> 
> Thanks; I attached an updated patch.  Removing `backtrace' from eval.c makes the patch much harder to read, so I'll do that later.

Thanks, allow me a few additional comments:

> ;; -*- lexical-binding: t -*-
> 
> (defun backtrace-1 (evald func args flags)
>   "Print a trace of a single stack frame to `standard-output'.
> EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
>   (let ((print-level (or print-level 8)))
>     (princ (if (plist-get flags :debug-on-exit) "* " "  "))
>     (cond
>      ((and evald (not debugger-stack-frame-as-list))
>       (prin1 func)
>       (if args (prin1 args) (princ "()")))
>      (t
>       (prin1 (cons func args))))
>     (princ "\n")))
> 
> (defun backtrace ()
>   "Print a trace of Lisp function calls currently active.
> Output stream used is value of `standard-output'."
>   (mapbacktrace #'backtrace-1 'backtrace))
> 
> (backtrace)
> 
> (defun backtrace-frames ()
>   "Collect all frames of current backtrace into a list."
>   (let ((frames nil))
>     (mapbacktrace (lambda (&rest frame) (push frame frames)) 'backtrace-frames)
>     (nreverse frames)))
> 
> (backtrace-frames)
> 
> (defun ~/backtrace-frame (nframes &optional base)
>   "Return the function and arguments NFRAMES up from current execution point.
> If that frame has not evaluated the arguments yet (or is a special form),
> the value is (nil FUNCTION ARG-FORMS...).
> If that frame has evaluated its arguments and called its function already,
> the value is (t FUNCTION ARG-VALUES...).
> A &rest arg is represented as the tail of the list ARG-VALUES.
> FUNCTION is whatever was supplied as car of evaluated list,
> or a lambda expression for macro calls.
> If NFRAMES is more than the number of frames, the value is nil.
> If BASE is non-nil, it should be a function and NFRAMES counts from its
> nearest activation frame."

It is better to move the description of BASE to the 2nd line, as it's
an argument of this function, while the rest describes the details of
what the function does.  It is plausible that someone would like to
read the doc string just as a reminder of the API, so we had better
not force them to read the entire doc string.

>   (let ((frame nil))
>     (mapbacktrace (lambda (evald func args _)
>                     (when (and base (eq func base))
>                       (setq base nil))
>                     (unless base
>                       (when (eq nframes 0)
>                         (setq frame `(,evald ,func ,@args)))
>                       (setq nframes (1- nframes))))
>                   '~/backtrace-frame)
>     frame))

These functions should go to subr.el, I think.

> +DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
> +       doc: /* Call FUNCTION for each frame in backtrace.

Likewise here: BASE is better described on the 2nd line.

> +FUNCTION is called with 4 arguments EVALD FUNC ARGS FLAGS.  If a frame
                                      ^
Colon ':' here, please.

> +      if (backtrace_debug_on_exit (pdl))
> +        {
> +          flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
> +        }

No need for braces if there's only one statement in the 'if' clause.

> +      if (backtrace_nargs (pdl) == UNEVALLED)
> +        {
> +          call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
> +        }

Same here.

Last, but not least: it would be nice to have a couple of tests for
this functionality.

Thanks again for working on this.

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Clément Pit--Claudel]

[-- Attachment #1.1.1: Type: text/plain, Size: 680 bytes --]

On 2016-12-05 09:37, Stefan Monnier wrote:
>> Removing `backtrace' from eval.c makes the patch much harder to read,
>> so I'll do that later.
> 
> M-x diff-unified->context RET
> 
> should solve this apparent problem.

Neat!  I've attached a cleaner patch, including documentation and a Changelog entry.

Help with the following warning would be much appreciated:

  eval.c:3436:1: warning: no previous prototype for ‘backtrace_frame_apply’ [-Wmissing-prototypes]
   backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
   ^

(why does this specific function cause this warning, while other newly introduced functions don't?)

Thanks,
Clément.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: 0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch --]
[-- Type: text/x-diff; name="0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch", Size: 13696 bytes --]

From 185736cd23be13677ef3528cf83ef4a4f3039c72 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] Move backtrace to ELisp using a new mapbacktrace primitive

* src/eval.c (get_backtrace_starting_at, backtrace_frame_apply)
(Fmapbacktrace, Fbacktrace_frame_internal): New functions.
(get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'.

* lisp/subr.el (backtrace--print-frame): New function.
(backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'.
(backtrace-frame): Reimplement using `backtrace-frame--internal'.

* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a
base to `mapbacktrace' instead of searching for "(debug" in
the output of `backtrace'.

* doc/lispref/debugging.texi (Internals of Debugger): Document
`mapbacktrace' and missing argument BASE of `backtrace-frame'.
---
 doc/lispref/debugging.texi |  24 ++++++-
 etc/NEWS                   |   4 ++
 lisp/emacs-lisp/debug.el   |  11 ++--
 lisp/subr.el               |  36 ++++++++++
 src/eval.c                 | 160 ++++++++++++++++++++-------------------------
 5 files changed, 140 insertions(+), 95 deletions(-)

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index c80b0f9..35ff9af 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -727,7 +727,7 @@ Internals of Debugger
 This variable is obsolete and will be removed in future versions.
 @end defvar
 
-@defun backtrace-frame frame-number
+@defun backtrace-frame frame-number &optional base
 The function @code{backtrace-frame} is intended for use in Lisp
 debuggers.  It returns information about what computation is happening
 in the stack frame @var{frame-number} levels down.
@@ -744,10 +744,32 @@ Internals of Debugger
 case of a macro call.  If the function has a @code{&rest} argument, that
 is represented as the tail of the list @var{arg-values}.
 
+If @var{base} is specified, @var{frame-number} counts relative to
+the topmost frame whose @var{function} is @var{base}.
+
 If @var{frame-number} is out of range, @code{backtrace-frame} returns
 @code{nil}.
 @end defun
 
+@defun mapbacktrace function &optional base
+The function @code{mapbacktrace} calls @var{function} once for each
+frame in the backtrace, starting at the first frame whose
+@var{function} is base (or from the top if @var{base} is omitted or
+@code{nil}).
+
+@var{function} is called with four arguments @var{evald} @var{func}
+@var{args} @var{flags}.
+
+If a frame has not evaluated its arguments yet or is a special form,
+@var{evald} is @code{nil} and @var{args} is a list of forms.
+
+If a frame has evaluated its arguments and called its function
+already, @var{evald} is @code{t} and @var{args} is a list of values.
+@var{flags} is a plist of properties of the current frame: currently,
+the only supported property is @code{:debug-on-exit}, which is t if
+the frame's debug-on-exit flag is set.
+@end defun
+
 @include edebug.texi
 
 @node Syntax Errors
diff --git a/etc/NEWS b/etc/NEWS
index a62668a..72bef06 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -74,6 +74,10 @@ for '--daemon'.
 * Changes in Emacs 26.1
 
 +++
+** The new function 'mapbacktrace' applies a function to all frames of
+the current stack trace.
+
++++
 ** The new function 'file-name-case-insensitive-p' tests whether a
 given file is on a case-insensitive filesystem.
 
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 5430b72..5a4b097 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -274,15 +274,14 @@ debugger-setup-buffer
   (let ((standard-output (current-buffer))
 	(print-escape-newlines t)
 	(print-level 8)
-	(print-length 50))
-    (backtrace))
+        (print-length 50))
+    ;; FIXME the debugger could pass a custom callback to mapbacktrace
+    ;; instead of manipulating printed results.
+    (mapbacktrace #'backtrace--print-frame 'debug))
   (goto-char (point-min))
   (delete-region (point)
 		 (progn
-		   (search-forward (if debugger-stack-frame-as-list
-                                       "\n  (debug "
-                                     "\n  debug("))
-		   (forward-line (if (eq (car args) 'debug)
+                   (forward-line (if (eq (car args) 'debug)
                                      ;; Remove debug--implement-debug-on-entry
                                      ;; and the advice's `apply' frame.
 				     3
diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..cb32e66 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4333,6 +4333,42 @@ define-mail-user-agent
   (put symbol 'sendfunc sendfunc)
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+\f
+(defun backtrace--print-frame (evald func args flags)
+  "Print a trace of a single stack frame to `standard-output'.
+EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
+  (princ (if (plist-get flags :debug-on-exit) "* " "  "))
+  (cond
+   ((and evald (not debugger-stack-frame-as-list))
+    (prin1 func)
+    (if args (prin1 args) (princ "()")))
+   (t
+    (prin1 (cons func args))))
+  (princ "\n"))
+
+(defun backtrace ()
+  "Print a trace of Lisp function calls currently active.
+Output stream used is value of `standard-output'."
+  (let ((print-level (or print-level 8)))
+    (mapbacktrace #'backtrace--print-frame 'backtrace)))
+
+(defun backtrace-frame (nframes &optional base)
+  "Return the function and arguments NFRAMES up from current execution point.
+If that frame has not evaluated the arguments yet (or is a special form),
+the value is (nil FUNCTION ARG-FORMS...).
+If that frame has evaluated its arguments and called its function already,
+the value is (t FUNCTION ARG-VALUES...).
+A &rest arg is represented as the tail of the list ARG-VALUES.
+FUNCTION is whatever was supplied as car of evaluated list,
+or a lambda expression for macro calls.
+If NFRAMES is more than the number of frames, the value is nil.
+If BASE is non-nil, it should be a function and NFRAMES counts from its
+nearest activation frame."
+  (backtrace-frame--internal
+   (lambda (evald func args _) `(,evald ,func ,@args))
+   nframes (or base 'backtrace-frame)))
+
 \f
 (defvar called-interactively-p-functions nil
   "Special hook called to skip special frames in `called-interactively-p'.
diff --git a/src/eval.c b/src/eval.c
index 724f001..9baa811 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3401,87 +3401,29 @@ context where binding is lexical by default.  */)
 }
 
 \f
-DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
-       doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
-The debugger is entered when that frame exits, if the flag is non-nil.  */)
-  (Lisp_Object level, Lisp_Object flag)
-{
-  union specbinding *pdl = backtrace_top ();
-  register EMACS_INT i;
-
-  CHECK_NUMBER (level);
-
-  for (i = 0; backtrace_p (pdl) && i < XINT (level); i++)
-    pdl = backtrace_next (pdl);
-
-  if (backtrace_p (pdl))
-    set_backtrace_debug_on_exit (pdl, !NILP (flag));
-
-  return flag;
-}
-
-DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
-       doc: /* Print a trace of Lisp function calls currently active.
-Output stream used is value of `standard-output'.  */)
-  (void)
+static union specbinding *
+get_backtrace_starting_at (Lisp_Object base)
 {
   union specbinding *pdl = backtrace_top ();
-  Lisp_Object tem;
-  Lisp_Object old_print_level = Vprint_level;
-
-  if (NILP (Vprint_level))
-    XSETFASTINT (Vprint_level, 8);
 
-  while (backtrace_p (pdl))
-    {
-      write_string (backtrace_debug_on_exit (pdl) ? "* " : "  ");
-      if (backtrace_nargs (pdl) == UNEVALLED)
-	{
-	  Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)),
-		  Qnil);
-	  write_string ("\n");
-	}
-      else
-	{
-	  tem = backtrace_function (pdl);
-	  if (debugger_stack_frame_as_list)
-	    write_string ("(");
-	  Fprin1 (tem, Qnil);	/* This can QUIT.  */
-	  if (!debugger_stack_frame_as_list)
-	    write_string ("(");
-	  {
-	    ptrdiff_t i;
-	    for (i = 0; i < backtrace_nargs (pdl); i++)
-	      {
-		if (i || debugger_stack_frame_as_list)
-		  write_string(" ");
-		Fprin1 (backtrace_args (pdl)[i], Qnil);
-	      }
-	  }
-	  write_string (")\n");
-	}
-      pdl = backtrace_next (pdl);
+  if (!NILP (base))
+    { /* Skip up to `base'.  */
+      base = Findirect_function (base, Qt);
+      while (backtrace_p (pdl)
+             && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+        pdl = backtrace_next (pdl);
     }
 
-  Vprint_level = old_print_level;
-  return Qnil;
+  return pdl;
 }
 
 static union specbinding *
 get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
 {
-  union specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NATNUM (nframes);
-
-  if (!NILP (base))
-    { /* Skip up to `base'.  */
-      base = Findirect_function (base, Qt);
-      while (backtrace_p (pdl)
-	     && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
-	pdl = backtrace_next (pdl);
-    }
+  union specbinding *pdl = get_backtrace_starting_at (base);
 
   /* Find the frame requested.  */
   for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
@@ -3490,33 +3432,74 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
   return pdl;
 }
 
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
-       doc: /* Return the function and arguments NFRAMES up from current execution point.
-If that frame has not evaluated the arguments yet (or is a special form),
-the value is (nil FUNCTION ARG-FORMS...).
-If that frame has evaluated its arguments and called its function already,
-the value is (t FUNCTION ARG-VALUES...).
-A &rest arg is represented as the tail of the list ARG-VALUES.
-FUNCTION is whatever was supplied as car of evaluated list,
-or a lambda expression for macro calls.
-If NFRAMES is more than the number of frames, the value is nil.
-If BASE is non-nil, it should be a function and NFRAMES counts from its
-nearest activation frame.  */)
-  (Lisp_Object nframes, Lisp_Object base)
+Lisp_Object
+backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
 {
-  union specbinding *pdl = get_backtrace_frame (nframes, base);
-
   if (!backtrace_p (pdl))
     return Qnil;
+
+  Lisp_Object flags = Qnil;
+  if (backtrace_debug_on_exit (pdl))
+    {
+      flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+    }
+
   if (backtrace_nargs (pdl) == UNEVALLED)
-    return Fcons (Qnil,
-		  Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
+    {
+      return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
+    }
   else
     {
       Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+      return call4 (function, Qt, backtrace_function (pdl), tem, flags);
+    }
+}
 
-      return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
+DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
+       doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
+The debugger is entered when that frame exits, if the flag is non-nil.  */)
+  (Lisp_Object level, Lisp_Object flag)
+{
+  CHECK_NUMBER (level);
+  union specbinding *pdl = get_backtrace_frame(level, Qnil);
+
+  if (backtrace_p (pdl))
+    set_backtrace_debug_on_exit (pdl, !NILP (flag));
+
+  return flag;
+}
+
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+       doc: /* Call FUNCTION for each frame in backtrace.
+FUNCTION is called with 4 arguments EVALD FUNC ARGS FLAGS.  If a frame
+has not evaluated its arguments yet or is a special form, EVALD is nil
+and ARGS is a list of forms.  If a frame has evaluated its arguments
+and called its function already, EVALD is t and ARGS is a list of
+values.  FLAGS is a plist of properties of the current frame:
+currently, the only supported property is :debug-on-exit.
+If BASE is non-nil, it should be a function and iteration will start
+from its nearest activation frame.
+`mapbacktrace' always returns nil.  */)
+     (Lisp_Object function, Lisp_Object base)
+{
+  union specbinding *pdl = get_backtrace_starting_at (base);
+
+  while (backtrace_p (pdl))
+    {
+      backtrace_frame_apply (function, pdl);
+      pdl = backtrace_next (pdl);
     }
+
+  return Qnil;
+}
+
+DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal,
+       Sbacktrace_frame_internal, 3, 3, NULL,
+       doc: /* Call FUNCTION on stack frame NFRAMES away from BASE.
+Return the result of FUNCTION, or nil if no matching frame could be found. */)
+     (Lisp_Object function, Lisp_Object nframes, Lisp_Object base)
+{
+  return backtrace_frame_apply (function, get_backtrace_frame (nframes, base));
 }
 
 /* For backtrace-eval, we want to temporarily unwind the last few elements of
@@ -3973,8 +3956,9 @@ alist of active lexical bindings.  */);
   defsubr (&Srun_hook_wrapped);
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
-  defsubr (&Sbacktrace);
-  defsubr (&Sbacktrace_frame);
+  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  defsubr (&Smapbacktrace);
+  defsubr (&Sbacktrace_frame_internal);
   defsubr (&Sbacktrace_eval);
   defsubr (&Sbacktrace__locals);
   defsubr (&Sspecial_variable_p);
-- 
2.7.4


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Eli Zaretskii]

> From: Clément Pit--Claudel <clement.pit@gmail.com>
> Date: Mon, 5 Dec 2016 11:31:03 -0500
> 
> Help with the following warning would be much appreciated:
> 
>   eval.c:3436:1: warning: no previous prototype for ‘backtrace_frame_apply’ [-Wmissing-prototypes]
>    backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
>    ^
> 
> (why does this specific function cause this warning, while other newly introduced functions don't?)

The others are static, this one isn't.  If it really needs to be
callable from other source files, you need to put its prototype in
some header file, probably lisp.h.  Otherwise, make it static.

I will review the patch soon.  Thanks.

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Clément Pit--Claudel]

[-- Attachment #1.1.1: Type: text/plain, Size: 254 bytes --]

On 2016-12-05 11:23, Eli Zaretskii wrote:
> Thanks, allow me a few additional comments:
> [...]
> Last, but not least: it would be nice to have a couple of tests for
> this functionality.

Done and done :) See attached patch.

Cheers,
Clément.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: 0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch --]
[-- Type: text/x-diff; name="0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch", Size: 16673 bytes --]

From 3545cb4325e030a9f8480b4451d6a095aedbc479 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] Move backtrace to ELisp using a new mapbacktrace primitive

* src/eval.c (get_backtrace_starting_at, backtrace_frame_apply)
(Fmapbacktrace, Fbacktrace_frame_internal): New functions.
(get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'.

* lisp/subr.el (backtrace--print-frame): New function.
(backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'.
(backtrace-frame): Reimplement using `backtrace-frame--internal'.

* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a base to
`mapbacktrace' instead of searching for "(debug" in the output of
`backtrace'.

* test/lisp/subr-tests.el (subr-test-backtrace-simple-tests)
(subr-test-backtrace-integration-test): New tests.

* doc/lispref/debugging.texi (Internals of Debugger): Document
`mapbacktrace' and missing argument BASE of `backtrace-frame'.
---
 doc/lispref/debugging.texi |  24 ++++++-
 etc/NEWS                   |   4 ++
 lisp/emacs-lisp/debug.el   |  11 ++--
 lisp/subr.el               |  45 +++++++++++++
 src/eval.c                 | 157 ++++++++++++++++++++-------------------------
 test/lisp/subr-tests.el    |  47 ++++++++++++++
 6 files changed, 193 insertions(+), 95 deletions(-)

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index c80b0f9..c05b0eb 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -727,7 +727,7 @@ Internals of Debugger
 This variable is obsolete and will be removed in future versions.
 @end defvar
 
-@defun backtrace-frame frame-number
+@defun backtrace-frame frame-number &optional base
 The function @code{backtrace-frame} is intended for use in Lisp
 debuggers.  It returns information about what computation is happening
 in the stack frame @var{frame-number} levels down.
@@ -744,10 +744,32 @@ Internals of Debugger
 case of a macro call.  If the function has a @code{&rest} argument, that
 is represented as the tail of the list @var{arg-values}.
 
+If @var{base} is specified, @var{frame-number} counts relative to
+the topmost frame whose @var{function} is @var{base}.
+
 If @var{frame-number} is out of range, @code{backtrace-frame} returns
 @code{nil}.
 @end defun
 
+@defun mapbacktrace function &optional base
+The function @code{mapbacktrace} calls @var{function} once for each
+frame in the backtrace, starting at the first frame whose
+@var{function} is base (or from the top if @var{base} is omitted or
+@code{nil}).
+
+@var{function} is called with four arguments: @var{evald}, @var{func},
+@var{args}, and @var{flags}.
+
+If a frame has not evaluated its arguments yet or is a special form,
+@var{evald} is @code{nil} and @var{args} is a list of forms.
+
+If a frame has evaluated its arguments and called its function
+already, @var{evald} is @code{t} and @var{args} is a list of values.
+@var{flags} is a plist of properties of the current frame: currently,
+the only supported property is @code{:debug-on-exit}, which is t if
+the frame's debug-on-exit flag is set.
+@end defun
+
 @include edebug.texi
 
 @node Syntax Errors
diff --git a/etc/NEWS b/etc/NEWS
index a62668a..72bef06 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -74,6 +74,10 @@ for '--daemon'.
 * Changes in Emacs 26.1
 
 +++
+** The new function 'mapbacktrace' applies a function to all frames of
+the current stack trace.
+
++++
 ** The new function 'file-name-case-insensitive-p' tests whether a
 given file is on a case-insensitive filesystem.
 
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 5430b72..5a4b097 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -274,15 +274,14 @@ debugger-setup-buffer
   (let ((standard-output (current-buffer))
 	(print-escape-newlines t)
 	(print-level 8)
-	(print-length 50))
-    (backtrace))
+        (print-length 50))
+    ;; FIXME the debugger could pass a custom callback to mapbacktrace
+    ;; instead of manipulating printed results.
+    (mapbacktrace #'backtrace--print-frame 'debug))
   (goto-char (point-min))
   (delete-region (point)
 		 (progn
-		   (search-forward (if debugger-stack-frame-as-list
-                                       "\n  (debug "
-                                     "\n  debug("))
-		   (forward-line (if (eq (car args) 'debug)
+                   (forward-line (if (eq (car args) 'debug)
                                      ;; Remove debug--implement-debug-on-entry
                                      ;; and the advice's `apply' frame.
 				     3
diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..658472d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4333,6 +4333,51 @@ define-mail-user-agent
   (put symbol 'sendfunc sendfunc)
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+\f
+(defun backtrace--print-frame (evald func args flags)
+  "Print a trace of a single stack frame to `standard-output'.
+EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
+  (princ (if (plist-get flags :debug-on-exit) "* " "  "))
+  (cond
+   ((and evald (not debugger-stack-frame-as-list))
+    (prin1 func)
+    (if args (prin1 args) (princ "()")))
+   (t
+    (prin1 (cons func args))))
+  (princ "\n"))
+
+(defun backtrace ()
+  "Print a trace of Lisp function calls currently active.
+Output stream used is value of `standard-output'."
+  (let ((print-level (or print-level 8)))
+    (mapbacktrace #'backtrace--print-frame 'backtrace)))
+
+(defun backtrace-frames (&optional base)
+  "Collect all frames of current backtrace into a list.
+If non-nil BASE should be a function, and frames before its
+nearest activation frames are discarded."
+  (let ((frames nil))
+    (mapbacktrace (lambda (&rest frame) (push frame frames))
+                  (or base 'backtrace-frames))
+    (nreverse frames)))
+
+(defun backtrace-frame (nframes &optional base)
+  "Return the function and arguments NFRAMES up from current execution point.
+If non-nil BASE should be a function, and NFRAMES counts from its
+nearest activation frame.
+If the frame has not evaluated the arguments yet (or is a special form),
+the value is (nil FUNCTION ARG-FORMS...).
+If the frame has evaluated its arguments and called its function already,
+the value is (t FUNCTION ARG-VALUES...).
+A &rest arg is represented as the tail of the list ARG-VALUES.
+FUNCTION is whatever was supplied as car of evaluated list,
+or a lambda expression for macro calls.
+If NFRAMES is more than the number of frames, the value is nil."
+  (backtrace-frame--internal
+   (lambda (evald func args _) `(,evald ,func ,@args))
+   nframes (or base 'backtrace-frame)))
+
 \f
 (defvar called-interactively-p-functions nil
   "Special hook called to skip special frames in `called-interactively-p'.
diff --git a/src/eval.c b/src/eval.c
index 724f001..50c02e5 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3401,87 +3401,29 @@ context where binding is lexical by default.  */)
 }
 
 \f
-DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
-       doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
-The debugger is entered when that frame exits, if the flag is non-nil.  */)
-  (Lisp_Object level, Lisp_Object flag)
-{
-  union specbinding *pdl = backtrace_top ();
-  register EMACS_INT i;
-
-  CHECK_NUMBER (level);
-
-  for (i = 0; backtrace_p (pdl) && i < XINT (level); i++)
-    pdl = backtrace_next (pdl);
-
-  if (backtrace_p (pdl))
-    set_backtrace_debug_on_exit (pdl, !NILP (flag));
-
-  return flag;
-}
-
-DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
-       doc: /* Print a trace of Lisp function calls currently active.
-Output stream used is value of `standard-output'.  */)
-  (void)
+static union specbinding *
+get_backtrace_starting_at (Lisp_Object base)
 {
   union specbinding *pdl = backtrace_top ();
-  Lisp_Object tem;
-  Lisp_Object old_print_level = Vprint_level;
 
-  if (NILP (Vprint_level))
-    XSETFASTINT (Vprint_level, 8);
-
-  while (backtrace_p (pdl))
-    {
-      write_string (backtrace_debug_on_exit (pdl) ? "* " : "  ");
-      if (backtrace_nargs (pdl) == UNEVALLED)
-	{
-	  Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)),
-		  Qnil);
-	  write_string ("\n");
-	}
-      else
-	{
-	  tem = backtrace_function (pdl);
-	  if (debugger_stack_frame_as_list)
-	    write_string ("(");
-	  Fprin1 (tem, Qnil);	/* This can QUIT.  */
-	  if (!debugger_stack_frame_as_list)
-	    write_string ("(");
-	  {
-	    ptrdiff_t i;
-	    for (i = 0; i < backtrace_nargs (pdl); i++)
-	      {
-		if (i || debugger_stack_frame_as_list)
-		  write_string(" ");
-		Fprin1 (backtrace_args (pdl)[i], Qnil);
-	      }
-	  }
-	  write_string (")\n");
-	}
-      pdl = backtrace_next (pdl);
+  if (!NILP (base))
+    { /* Skip up to `base'.  */
+      base = Findirect_function (base, Qt);
+      while (backtrace_p (pdl)
+             && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+        pdl = backtrace_next (pdl);
     }
 
-  Vprint_level = old_print_level;
-  return Qnil;
+  return pdl;
 }
 
 static union specbinding *
 get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
 {
-  union specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NATNUM (nframes);
-
-  if (!NILP (base))
-    { /* Skip up to `base'.  */
-      base = Findirect_function (base, Qt);
-      while (backtrace_p (pdl)
-	     && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
-	pdl = backtrace_next (pdl);
-    }
+  union specbinding *pdl = get_backtrace_starting_at (base);
 
   /* Find the frame requested.  */
   for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
@@ -3490,33 +3432,71 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
   return pdl;
 }
 
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
-       doc: /* Return the function and arguments NFRAMES up from current execution point.
-If that frame has not evaluated the arguments yet (or is a special form),
-the value is (nil FUNCTION ARG-FORMS...).
-If that frame has evaluated its arguments and called its function already,
-the value is (t FUNCTION ARG-VALUES...).
-A &rest arg is represented as the tail of the list ARG-VALUES.
-FUNCTION is whatever was supplied as car of evaluated list,
-or a lambda expression for macro calls.
-If NFRAMES is more than the number of frames, the value is nil.
-If BASE is non-nil, it should be a function and NFRAMES counts from its
-nearest activation frame.  */)
-  (Lisp_Object nframes, Lisp_Object base)
+static Lisp_Object
+backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
 {
-  union specbinding *pdl = get_backtrace_frame (nframes, base);
-
   if (!backtrace_p (pdl))
     return Qnil;
+
+  Lisp_Object flags = Qnil;
+  if (backtrace_debug_on_exit (pdl))
+      flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+
   if (backtrace_nargs (pdl) == UNEVALLED)
-    return Fcons (Qnil,
-		  Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
+      return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
   else
     {
       Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+      return call4 (function, Qt, backtrace_function (pdl), tem, flags);
+    }
+}
 
-      return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
+DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
+       doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
+The debugger is entered when that frame exits, if the flag is non-nil.  */)
+  (Lisp_Object level, Lisp_Object flag)
+{
+  CHECK_NUMBER (level);
+  union specbinding *pdl = get_backtrace_frame(level, Qnil);
+
+  if (backtrace_p (pdl))
+    set_backtrace_debug_on_exit (pdl, !NILP (flag));
+
+  return flag;
+}
+
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+       doc: /* Call FUNCTION for each frame in backtrace.
+If BASE is non-nil, it should be a function and iteration will start
+from its nearest activation frame.
+FUNCTION is called with 4 arguments: EVALD, FUNC, ARGS, and FLAGS.  If
+a frame has not evaluated its arguments yet or is a special form,
+EVALD is nil and ARGS is a list of forms.  If a frame has evaluated
+its arguments and called its function already, EVALD is t and ARGS is
+a list of values.
+FLAGS is a plist of properties of the current frame: currently, the
+only supported property is :debug-on-exit.  `mapbacktrace' always
+returns nil.  */)
+     (Lisp_Object function, Lisp_Object base)
+{
+  union specbinding *pdl = get_backtrace_starting_at (base);
+
+  while (backtrace_p (pdl))
+    {
+      backtrace_frame_apply (function, pdl);
+      pdl = backtrace_next (pdl);
     }
+
+  return Qnil;
+}
+
+DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal,
+       Sbacktrace_frame_internal, 3, 3, NULL,
+       doc: /* Call FUNCTION on stack frame NFRAMES away from BASE.
+Return the result of FUNCTION, or nil if no matching frame could be found. */)
+     (Lisp_Object function, Lisp_Object nframes, Lisp_Object base)
+{
+  return backtrace_frame_apply (function, get_backtrace_frame (nframes, base));
 }
 
 /* For backtrace-eval, we want to temporarily unwind the last few elements of
@@ -3973,8 +3953,9 @@ alist of active lexical bindings.  */);
   defsubr (&Srun_hook_wrapped);
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
-  defsubr (&Sbacktrace);
-  defsubr (&Sbacktrace_frame);
+  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  defsubr (&Smapbacktrace);
+  defsubr (&Sbacktrace_frame_internal);
   defsubr (&Sbacktrace_eval);
   defsubr (&Sbacktrace__locals);
   defsubr (&Sspecial_variable_p);
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..82a70ca 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,52 @@
               (error-message-string (should-error (version-to-list "beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
 
+(defun subr-test--backtrace-frames-with-backtrace-frame (base)
+  "Reference implementation of `backtrace-frames'."
+  (let ((idx 0)
+        (frame nil)
+        (frames nil))
+    (while (setq frame (backtrace-frame idx base))
+      (push frame frames)
+      (setq idx (1+ idx)))
+    (nreverse frames)))
+
+(defun subr-test--frames-2 (base)
+  (let ((_dummy nil))
+    (progn ;; Add a few frames to top of stack
+      (unwind-protect
+          (cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_))
+                          `(,evald ,func ,@args))
+                        (backtrace-frames base))
+                (subr-test--backtrace-frames-with-backtrace-frame base))))))
+
+(defun subr-test--frames-1 (base)
+  (subr-test--frames-2 base))
+
+(ert-deftest subr-test-backtrace-simple-tests ()
+  "Test backtrace-related functions (simple tests).
+This exercises `backtrace-frame', and indirectly `mapbacktrace'."
+  ;; `mapbacktrace' returns nil
+  (should (equal (mapbacktrace #'ignore) nil))
+  ;; Unbound BASE is silently ignored
+  (let ((unbound (make-symbol "ub")))
+    (should (equal (backtrace-frame 0 unbound) nil))
+    (should (equal (mapbacktrace #'error unbound) nil)))
+  ;; First frame is backtrace-related function
+  (should (equal (backtrace-frame 0) '(t backtrace-frame 0)))
+  (should (equal (catch 'ret
+                   (mapbacktrace (lambda (&rest args) (throw 'ret args))))
+                 '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil)))
+  ;; Past-end NFRAMES is silently ignored
+  (should (equal (backtrace-frame most-positive-fixnum) nil)))
+
+(ert-deftest subr-test-backtrace-integration-test ()
+  "Test backtrace-related functions (integration test).
+This exercises `backtrace-frame', `backtrace-frames', and
+indirectly `mapbacktrace'."
+  ;; Compare two implementations of backtrace-frames
+  (let ((frame-lists (subr-test--frames-1 'subr-test--frames-2)))
+    (should (equal (car frame-lists) (cdr frame-lists)))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.7.4


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Eli Zaretskii]

> Cc: emacs-devel@gnu.org
> From: Clément Pit--Claudel <clement.pit@gmail.com>
> Date: Mon, 5 Dec 2016 13:59:03 -0500
> 
> Done and done :) See attached patch.

Thanks.

> +@defun mapbacktrace function &optional base
> +The function @code{mapbacktrace} calls @var{function} once for each
> +frame in the backtrace, starting at the first frame whose
> +@var{function} is base (or from the top if @var{base} is omitted or
   ^^^^^^^^^^^^^^^^^^^^^^
Here, "function" should not have the @var markup, and "base" should.

> +the only supported property is @code{:debug-on-exit}, which is t if
                                                                  ^
@code{t}

> +the frame's debug-on-exit flag is set.
               ^^^^^^^^^^^^^
@code{debug-on-exit}

Also, suggest to say "stack frame's", to avoid confusion with the
frames on display.

> +(defun backtrace-frames (&optional base)
> +  "Collect all frames of current backtrace into a list.
> +If non-nil BASE should be a function, and frames before its
             ^
Comma here.

> +(defun backtrace-frame (nframes &optional base)
> +  "Return the function and arguments NFRAMES up from current execution point.
> +If non-nil BASE should be a function, and NFRAMES counts from its
             ^
Likewise.

> +  if (backtrace_debug_on_exit (pdl))
> +      flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
     ^^^^
Too many blanks here.  Should be only 2.

Otherwise, LGTM.

Thanks for doing this!

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Clément Pit--Claudel]

[-- Attachment #1.1.1: Type: text/plain, Size: 202 bytes --]

On 2016-12-06 13:55, Eli Zaretskii wrote:
> […]
> Otherwise, LGTM.

Thanks a lot for the review! I've attached an updated patch, which I'll to master in a few days if no one objects :)

Clément.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: 0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch --]
[-- Type: text/x-diff; name="0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch", Size: 16689 bytes --]

From 0a525bc06b992c2995dd8f5853f9485588a2bf88 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] Move backtrace to ELisp using a new mapbacktrace primitive

* src/eval.c (get_backtrace_starting_at, backtrace_frame_apply)
(Fmapbacktrace, Fbacktrace_frame_internal): New functions.
(get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'.

* lisp/subr.el (backtrace--print-frame): New function.
(backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'.
(backtrace-frame): Reimplement using `backtrace-frame--internal'.

* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a base to
`mapbacktrace' instead of searching for "(debug" in the output of
`backtrace'.

* test/lisp/subr-tests.el (subr-test-backtrace-simple-tests)
(subr-test-backtrace-integration-test): New tests.

* doc/lispref/debugging.texi (Internals of Debugger): Document
`mapbacktrace' and missing argument BASE of `backtrace-frame'.
---
 doc/lispref/debugging.texi |  23 ++++++-
 etc/NEWS                   |   4 ++
 lisp/emacs-lisp/debug.el   |  11 ++--
 lisp/subr.el               |  45 +++++++++++++
 src/eval.c                 | 157 ++++++++++++++++++++-------------------------
 test/lisp/subr-tests.el    |  47 ++++++++++++++
 6 files changed, 192 insertions(+), 95 deletions(-)

diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index c80b0f9..8fb663d 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -727,7 +727,7 @@ Internals of Debugger
 This variable is obsolete and will be removed in future versions.
 @end defvar
 
-@defun backtrace-frame frame-number
+@defun backtrace-frame frame-number &optional base
 The function @code{backtrace-frame} is intended for use in Lisp
 debuggers.  It returns information about what computation is happening
 in the stack frame @var{frame-number} levels down.
@@ -744,10 +744,31 @@ Internals of Debugger
 case of a macro call.  If the function has a @code{&rest} argument, that
 is represented as the tail of the list @var{arg-values}.
 
+If @var{base} is specified, @var{frame-number} counts relative to
+the topmost frame whose @var{function} is @var{base}.
+
 If @var{frame-number} is out of range, @code{backtrace-frame} returns
 @code{nil}.
 @end defun
 
+@defun mapbacktrace function &optional base
+The function @code{mapbacktrace} calls @var{function} once for each
+frame in the backtrace, starting at the first frame whose function is
+@var{base} (or from the top if @var{base} is omitted or @code{nil}).
+
+@var{function} is called with four arguments: @var{evald}, @var{func},
+@var{args}, and @var{flags}.
+
+If a frame has not evaluated its arguments yet or is a special form,
+@var{evald} is @code{nil} and @var{args} is a list of forms.
+
+If a frame has evaluated its arguments and called its function
+already, @var{evald} is @code{t} and @var{args} is a list of values.
+@var{flags} is a plist of properties of the current frame: currently,
+the only supported property is @code{:debug-on-exit}, which is
+@code{t} if the stack frame's @code{debug-on-exit} flag is set.
+@end defun
+
 @include edebug.texi
 
 @node Syntax Errors
diff --git a/etc/NEWS b/etc/NEWS
index a62668a..72bef06 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -74,6 +74,10 @@ for '--daemon'.
 * Changes in Emacs 26.1
 
 +++
+** The new function 'mapbacktrace' applies a function to all frames of
+the current stack trace.
+
++++
 ** The new function 'file-name-case-insensitive-p' tests whether a
 given file is on a case-insensitive filesystem.
 
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 5430b72..5a4b097 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -274,15 +274,14 @@ debugger-setup-buffer
   (let ((standard-output (current-buffer))
 	(print-escape-newlines t)
 	(print-level 8)
-	(print-length 50))
-    (backtrace))
+        (print-length 50))
+    ;; FIXME the debugger could pass a custom callback to mapbacktrace
+    ;; instead of manipulating printed results.
+    (mapbacktrace #'backtrace--print-frame 'debug))
   (goto-char (point-min))
   (delete-region (point)
 		 (progn
-		   (search-forward (if debugger-stack-frame-as-list
-                                       "\n  (debug "
-                                     "\n  debug("))
-		   (forward-line (if (eq (car args) 'debug)
+                   (forward-line (if (eq (car args) 'debug)
                                      ;; Remove debug--implement-debug-on-entry
                                      ;; and the advice's `apply' frame.
 				     3
diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..6ab1d5f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4333,6 +4333,51 @@ define-mail-user-agent
   (put symbol 'sendfunc sendfunc)
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+\f
+(defun backtrace--print-frame (evald func args flags)
+  "Print a trace of a single stack frame to `standard-output'.
+EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
+  (princ (if (plist-get flags :debug-on-exit) "* " "  "))
+  (cond
+   ((and evald (not debugger-stack-frame-as-list))
+    (prin1 func)
+    (if args (prin1 args) (princ "()")))
+   (t
+    (prin1 (cons func args))))
+  (princ "\n"))
+
+(defun backtrace ()
+  "Print a trace of Lisp function calls currently active.
+Output stream used is value of `standard-output'."
+  (let ((print-level (or print-level 8)))
+    (mapbacktrace #'backtrace--print-frame 'backtrace)))
+
+(defun backtrace-frames (&optional base)
+  "Collect all frames of current backtrace into a list.
+If non-nil, BASE should be a function, and frames before its
+nearest activation frames are discarded."
+  (let ((frames nil))
+    (mapbacktrace (lambda (&rest frame) (push frame frames))
+                  (or base 'backtrace-frames))
+    (nreverse frames)))
+
+(defun backtrace-frame (nframes &optional base)
+  "Return the function and arguments NFRAMES up from current execution point.
+If non-nil, BASE should be a function, and NFRAMES counts from its
+nearest activation frame.
+If the frame has not evaluated the arguments yet (or is a special form),
+the value is (nil FUNCTION ARG-FORMS...).
+If the frame has evaluated its arguments and called its function already,
+the value is (t FUNCTION ARG-VALUES...).
+A &rest arg is represented as the tail of the list ARG-VALUES.
+FUNCTION is whatever was supplied as car of evaluated list,
+or a lambda expression for macro calls.
+If NFRAMES is more than the number of frames, the value is nil."
+  (backtrace-frame--internal
+   (lambda (evald func args _) `(,evald ,func ,@args))
+   nframes (or base 'backtrace-frame)))
+
 \f
 (defvar called-interactively-p-functions nil
   "Special hook called to skip special frames in `called-interactively-p'.
diff --git a/src/eval.c b/src/eval.c
index 724f001..929b942 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3401,87 +3401,29 @@ context where binding is lexical by default.  */)
 }
 
 \f
-DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
-       doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
-The debugger is entered when that frame exits, if the flag is non-nil.  */)
-  (Lisp_Object level, Lisp_Object flag)
-{
-  union specbinding *pdl = backtrace_top ();
-  register EMACS_INT i;
-
-  CHECK_NUMBER (level);
-
-  for (i = 0; backtrace_p (pdl) && i < XINT (level); i++)
-    pdl = backtrace_next (pdl);
-
-  if (backtrace_p (pdl))
-    set_backtrace_debug_on_exit (pdl, !NILP (flag));
-
-  return flag;
-}
-
-DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
-       doc: /* Print a trace of Lisp function calls currently active.
-Output stream used is value of `standard-output'.  */)
-  (void)
+static union specbinding *
+get_backtrace_starting_at (Lisp_Object base)
 {
   union specbinding *pdl = backtrace_top ();
-  Lisp_Object tem;
-  Lisp_Object old_print_level = Vprint_level;
 
-  if (NILP (Vprint_level))
-    XSETFASTINT (Vprint_level, 8);
-
-  while (backtrace_p (pdl))
-    {
-      write_string (backtrace_debug_on_exit (pdl) ? "* " : "  ");
-      if (backtrace_nargs (pdl) == UNEVALLED)
-	{
-	  Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)),
-		  Qnil);
-	  write_string ("\n");
-	}
-      else
-	{
-	  tem = backtrace_function (pdl);
-	  if (debugger_stack_frame_as_list)
-	    write_string ("(");
-	  Fprin1 (tem, Qnil);	/* This can QUIT.  */
-	  if (!debugger_stack_frame_as_list)
-	    write_string ("(");
-	  {
-	    ptrdiff_t i;
-	    for (i = 0; i < backtrace_nargs (pdl); i++)
-	      {
-		if (i || debugger_stack_frame_as_list)
-		  write_string(" ");
-		Fprin1 (backtrace_args (pdl)[i], Qnil);
-	      }
-	  }
-	  write_string (")\n");
-	}
-      pdl = backtrace_next (pdl);
+  if (!NILP (base))
+    { /* Skip up to `base'.  */
+      base = Findirect_function (base, Qt);
+      while (backtrace_p (pdl)
+             && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+        pdl = backtrace_next (pdl);
     }
 
-  Vprint_level = old_print_level;
-  return Qnil;
+  return pdl;
 }
 
 static union specbinding *
 get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
 {
-  union specbinding *pdl = backtrace_top ();
   register EMACS_INT i;
 
   CHECK_NATNUM (nframes);
-
-  if (!NILP (base))
-    { /* Skip up to `base'.  */
-      base = Findirect_function (base, Qt);
-      while (backtrace_p (pdl)
-	     && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
-	pdl = backtrace_next (pdl);
-    }
+  union specbinding *pdl = get_backtrace_starting_at (base);
 
   /* Find the frame requested.  */
   for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
@@ -3490,33 +3432,71 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
   return pdl;
 }
 
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
-       doc: /* Return the function and arguments NFRAMES up from current execution point.
-If that frame has not evaluated the arguments yet (or is a special form),
-the value is (nil FUNCTION ARG-FORMS...).
-If that frame has evaluated its arguments and called its function already,
-the value is (t FUNCTION ARG-VALUES...).
-A &rest arg is represented as the tail of the list ARG-VALUES.
-FUNCTION is whatever was supplied as car of evaluated list,
-or a lambda expression for macro calls.
-If NFRAMES is more than the number of frames, the value is nil.
-If BASE is non-nil, it should be a function and NFRAMES counts from its
-nearest activation frame.  */)
-  (Lisp_Object nframes, Lisp_Object base)
+static Lisp_Object
+backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
 {
-  union specbinding *pdl = get_backtrace_frame (nframes, base);
-
   if (!backtrace_p (pdl))
     return Qnil;
+
+  Lisp_Object flags = Qnil;
+  if (backtrace_debug_on_exit (pdl))
+    flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+
   if (backtrace_nargs (pdl) == UNEVALLED)
-    return Fcons (Qnil,
-		  Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
+    return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
   else
     {
       Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+      return call4 (function, Qt, backtrace_function (pdl), tem, flags);
+    }
+}
 
-      return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
+DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
+       doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
+The debugger is entered when that frame exits, if the flag is non-nil.  */)
+  (Lisp_Object level, Lisp_Object flag)
+{
+  CHECK_NUMBER (level);
+  union specbinding *pdl = get_backtrace_frame(level, Qnil);
+
+  if (backtrace_p (pdl))
+    set_backtrace_debug_on_exit (pdl, !NILP (flag));
+
+  return flag;
+}
+
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+       doc: /* Call FUNCTION for each frame in backtrace.
+If BASE is non-nil, it should be a function and iteration will start
+from its nearest activation frame.
+FUNCTION is called with 4 arguments: EVALD, FUNC, ARGS, and FLAGS.  If
+a frame has not evaluated its arguments yet or is a special form,
+EVALD is nil and ARGS is a list of forms.  If a frame has evaluated
+its arguments and called its function already, EVALD is t and ARGS is
+a list of values.
+FLAGS is a plist of properties of the current frame: currently, the
+only supported property is :debug-on-exit.  `mapbacktrace' always
+returns nil.  */)
+     (Lisp_Object function, Lisp_Object base)
+{
+  union specbinding *pdl = get_backtrace_starting_at (base);
+
+  while (backtrace_p (pdl))
+    {
+      backtrace_frame_apply (function, pdl);
+      pdl = backtrace_next (pdl);
     }
+
+  return Qnil;
+}
+
+DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal,
+       Sbacktrace_frame_internal, 3, 3, NULL,
+       doc: /* Call FUNCTION on stack frame NFRAMES away from BASE.
+Return the result of FUNCTION, or nil if no matching frame could be found. */)
+     (Lisp_Object function, Lisp_Object nframes, Lisp_Object base)
+{
+  return backtrace_frame_apply (function, get_backtrace_frame (nframes, base));
 }
 
 /* For backtrace-eval, we want to temporarily unwind the last few elements of
@@ -3973,8 +3953,9 @@ alist of active lexical bindings.  */);
   defsubr (&Srun_hook_wrapped);
   defsubr (&Sfetch_bytecode);
   defsubr (&Sbacktrace_debug);
-  defsubr (&Sbacktrace);
-  defsubr (&Sbacktrace_frame);
+  DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+  defsubr (&Smapbacktrace);
+  defsubr (&Sbacktrace_frame_internal);
   defsubr (&Sbacktrace_eval);
   defsubr (&Sbacktrace__locals);
   defsubr (&Sspecial_variable_p);
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..82a70ca 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,52 @@
               (error-message-string (should-error (version-to-list "beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a number)"))))
 
+(defun subr-test--backtrace-frames-with-backtrace-frame (base)
+  "Reference implementation of `backtrace-frames'."
+  (let ((idx 0)
+        (frame nil)
+        (frames nil))
+    (while (setq frame (backtrace-frame idx base))
+      (push frame frames)
+      (setq idx (1+ idx)))
+    (nreverse frames)))
+
+(defun subr-test--frames-2 (base)
+  (let ((_dummy nil))
+    (progn ;; Add a few frames to top of stack
+      (unwind-protect
+          (cons (mapcar (pcase-lambda (`(,evald ,func ,args ,_))
+                          `(,evald ,func ,@args))
+                        (backtrace-frames base))
+                (subr-test--backtrace-frames-with-backtrace-frame base))))))
+
+(defun subr-test--frames-1 (base)
+  (subr-test--frames-2 base))
+
+(ert-deftest subr-test-backtrace-simple-tests ()
+  "Test backtrace-related functions (simple tests).
+This exercises `backtrace-frame', and indirectly `mapbacktrace'."
+  ;; `mapbacktrace' returns nil
+  (should (equal (mapbacktrace #'ignore) nil))
+  ;; Unbound BASE is silently ignored
+  (let ((unbound (make-symbol "ub")))
+    (should (equal (backtrace-frame 0 unbound) nil))
+    (should (equal (mapbacktrace #'error unbound) nil)))
+  ;; First frame is backtrace-related function
+  (should (equal (backtrace-frame 0) '(t backtrace-frame 0)))
+  (should (equal (catch 'ret
+                   (mapbacktrace (lambda (&rest args) (throw 'ret args))))
+                 '(t mapbacktrace ((lambda (&rest args) (throw 'ret args))) nil)))
+  ;; Past-end NFRAMES is silently ignored
+  (should (equal (backtrace-frame most-positive-fixnum) nil)))
+
+(ert-deftest subr-test-backtrace-integration-test ()
+  "Test backtrace-related functions (integration test).
+This exercises `backtrace-frame', `backtrace-frames', and
+indirectly `mapbacktrace'."
+  ;; Compare two implementations of backtrace-frames
+  (let ((frame-lists (subr-test--frames-1 'subr-test--frames-2)))
+    (should (equal (car frame-lists) (cdr frame-lists)))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.7.4


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]

Re: Lisp-friendly backtraces [was: Lispy backtraces]

[Clément Pit--Claudel]

[-- Attachment #1.1: Type: text/plain, Size: 157 bytes --]

On 2016-12-07 03:27, Clément Pit--Claudel wrote:
> I've attached an updated patch, which I'll to push master in a few days if no one objects :)

Done!


[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]