From 5eec048c8e966c806445e67f0e778826a4c02830 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 1 Jan 2021 12:11:00 -0800
Subject: New macro: prog2

* eval.c (prog2_s): New symbol variable.
(me_prog2): New macro expander function.
(eval_init): Initialize prog2_s variable with interned
symbol.
Register prog2 macro expander.

* txr.1: Maintain the documentation for progn and prog1,
improving the wording and adding a dialect note .
Document prog2.
---
 eval.c | 15 ++++++++++++++-
 txr.1  | 49 +++++++++++++++++++++++++++++++++++++++++++++----
 2 files changed, 59 insertions(+), 5 deletions(-)

diff --git a/eval.c b/eval.c
index d5307958..8b0cb0a3 100644
--- a/eval.c
+++ b/eval.c
@@ -73,7 +73,8 @@ val op_table, pm_table;
 val dyn_env;
 
 val eval_error_s;
-val dwim_s, progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s, dvbind_s;
+val dwim_s, progn_s, prog1_s, prog2_s;
+val let_s, let_star_s, lambda_s, call_s, dvbind_s;
 val sys_catch_s, handler_bind_s, cond_s, if_s, iflet_s, when_s, usr_var_s;
 val defvar_s, defvarl_s, defparm_s, defparml_s, defun_s, defmacro_s, macro_s;
 val tree_case_s, tree_bind_s, mac_param_bind_s;
@@ -4145,6 +4146,16 @@ static val me_case(val form, val menv)
               cons(cond_s, condpairs), nao);
 }
 
+static val me_prog2(val form, val menv)
+{
+  val arg1 = cadr(form);
+
+  (void) menv;
+
+  return list(progn_s, arg1,
+              cons(prog1_s, cddr(form)), nao);
+}
+
 static val me_tb(val form, val menv)
 {
   val opsym = pop(&form);
@@ -6271,6 +6282,7 @@ void eval_init(void)
   dwim_s = intern(lit("dwim"), user_package);
   progn_s = intern(lit("progn"), user_package);
   prog1_s = intern(lit("prog1"), user_package);
+  prog2_s = intern(lit("prog2"), user_package);
   let_s = intern(lit("let"), user_package);
   let_star_s = intern(lit("let*"), user_package);
   lambda_s = intern(lit("lambda"), user_package);
@@ -6484,6 +6496,7 @@ void eval_init(void)
   reg_mac(caseq_star_s, func_n2(me_case));
   reg_mac(caseql_star_s, func_n2(me_case));
   reg_mac(casequal_star_s, func_n2(me_case));
+  reg_mac(prog2_s, func_n2(me_prog2));
   reg_mac(intern(lit("tb"), user_package), func_n2(me_tb));
   reg_mac(intern(lit("tc"), user_package), func_n2(me_tc));
   reg_mac(intern(lit("ignerr"), user_package), func_n2(me_ignerr));
diff --git a/txr.1 b/txr.1
index 3ce278ac..c3aac32a 100644
--- a/txr.1
+++ b/txr.1
@@ -15085,16 +15085,20 @@ share any portion of the environment at any level of nesting.
 .desc
 The
 .code progn
-operator evaluates forms in order, and returns the value
-of the last form. The return value of the form
+operator evaluates each
+.meta form
+in in left-to-right order, and returns the value
+of the last form. The value of the form
 .code (progn)
 is
 .codn nil .
 
 The
 .code prog1
-operator evaluates forms in order, and returns the value
-of the first form. The return value of the form
+operator evaluates each
+.meta form
+in left-to-right order, and returns the value
+of the first form. The value of the form
 .code (prog1)
 is
 .codn nil .
@@ -15106,6 +15110,43 @@ of a body of forms, the value of the last of which is returned.
 These operators are said to feature an implicit
 .codn progn .
 
+.TP* "Dialect Note:"
+In ANSI Common Lisp,
+.code prog1
+requires at least one argument.
+
+.coNP Macro @ prog2
+.synb
+.mets (prog2 << form *)
+.syne
+.desc
+The
+.code prog2
+evaluates each
+.meta form
+in left-to-right order. The value is that of the second form, if present,
+otherwise it is
+.codn nil .
+
+The form
+.code "(prog2 1 2 3)"
+yields
+.codn 2 .
+The value of
+.code "(prog2 1 2)"
+is also
+.codn 2 ;
+.code "(prog2 1)"
+and
+.code "(prog2)"
+yield
+.codn nil .
+
+.TP* "Dialect Note:"
+In ANSI Common Lisp,
+.code prog2
+requires at least two arguments.
+
 .coNP Operator @ cond
 .synb
 .mets (cond >> {( test << form *)}*)
-- 
cgit v1.2.3