Re: Define progn_ignore to run Fprogn and ignore output

[Paul Eggert <eggert@cs.ucla.edu>]

[-- Attachment #1: Type: text/plain, Size: 514 bytes --]

Chris Gregory wrote:
> I'll try to benchmark it
> tomorrow. If it inlines the function to Fprogn then there is no benefit to
> performance (assuming it elides the Lisp_Object completely). The code,
> however, is cleaner now.

Thanks, I looked into this and there's no need to benchmark, as the change (when 
fixed up) does not alter the generated machine code, at least on my platform 
(Fedora 24 x86-64, GCC 6.3.1). The basic idea does simplify and clarify the code 
a bit, so I installed the attached.

[-- Attachment #2: 0001-Simplify-prog1-implementation.txt --]
[-- Type: text/plain, Size: 3243 bytes --]

From a02ca7a231c3856efd57a502c6a73e6c251091e8 Mon Sep 17 00:00:00 2001
From: Paul Eggert <eggert@cs.ucla.edu>
Date: Tue, 27 Dec 2016 10:32:44 -0800
Subject: [PATCH] Simplify prog1 implementation
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Inspired by a suggestion from Chris Gregory in:
http://lists.gnu.org/archive/html/emacs-devel/2016-12/msg00965.html
On my platform, this generates exactly the same machine insns.
* src/eval.c (prog_ignore): Rename from unwind_body, since
it’s more general than that.  All callers changed.
(Fprog1): Simplify by using prog_ignore.
(Fwhile): Clarify by using prog_ignore.
---
 src/bytecode.c |  2 +-
 src/eval.c     | 21 ++++++---------------
 src/lisp.h     |  2 +-
 3 files changed, 8 insertions(+), 17 deletions(-)

diff --git a/src/bytecode.c b/src/bytecode.c
index d484dbb..3bb96c2 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -809,7 +809,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	  {
 	    Lisp_Object handler = POP;
 	    /* Support for a function here is new in 24.4.  */
-	    record_unwind_protect (FUNCTIONP (handler) ? bcall0 : unwind_body,
+	    record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore,
 				   handler);
 	    NEXT;
 	  }
diff --git a/src/eval.c b/src/eval.c
index ddcccc2..e50e26a 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -453,11 +453,10 @@ usage: (progn BODY...)  */)
   return val;
 }
 
-/* Evaluate BODY sequentially, discarding its value.  Suitable for
-   record_unwind_protect.  */
+/* Evaluate BODY sequentially, discarding its value.  */
 
 void
-unwind_body (Lisp_Object body)
+prog_ignore (Lisp_Object body)
 {
   Fprogn (body);
 }
@@ -469,16 +468,8 @@ whose values are discarded.
 usage: (prog1 FIRST BODY...)  */)
   (Lisp_Object args)
 {
-  Lisp_Object val;
-  Lisp_Object args_left;
-
-  args_left = args;
-  val = args;
-
-  val = eval_sub (XCAR (args_left));
-  while (CONSP (args_left = XCDR (args_left)))
-    eval_sub (XCAR (args_left));
-
+  Lisp_Object val = eval_sub (XCAR (args));
+  prog_ignore (XCDR (args));
   return val;
 }
 
@@ -988,7 +979,7 @@ usage: (while TEST BODY...)  */)
   while (!NILP (eval_sub (test)))
     {
       QUIT;
-      Fprogn (body);
+      prog_ignore (body);
     }
 
   return Qnil;
@@ -1191,7 +1182,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...)  */)
   Lisp_Object val;
   ptrdiff_t count = SPECPDL_INDEX ();
 
-  record_unwind_protect (unwind_body, XCDR (args));
+  record_unwind_protect (prog_ignore, XCDR (args));
   val = eval_sub (XCAR (args));
   return unbind_to (count, val);
 }
diff --git a/src/lisp.h b/src/lisp.h
index dc2c7a6..1a586ca 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3867,7 +3867,7 @@ extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
 extern void init_eval (void);
 extern void syms_of_eval (void);
-extern void unwind_body (Lisp_Object);
+extern void prog_ignore (Lisp_Object);
 extern ptrdiff_t record_in_backtrace (Lisp_Object, Lisp_Object *, ptrdiff_t);
 extern void mark_specpdl (union specbinding *first, union specbinding *ptr);
 extern void get_backtrace (Lisp_Object array);
-- 
2.7.4