From df9904609a72052b1014f48e4de8fa1baa74fc94 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Fri, 1 Jan 2021 13:57:38 -0800
Subject: progn, prog1, prog2: now also functions.

* eval.c (progn_fun, prog1_fun, prog2_fun): New static
functions.
(eval_init): Wire progn, prog1 and prog2 function bindings
to new functions.

* txr.1: Documented.

* checkman.txr (check-func): Recognize Macro/function and
Operators/functions heading.
---
 checkman.txr |  6 +++---
 eval.c       | 19 +++++++++++++++++++
 txr.1        | 33 ++++++++++++++++++++++++++++-----
 3 files changed, 50 insertions(+), 8 deletions(-)

diff --git a/checkman.txr b/checkman.txr
index dcbf99e7..cbec82be 100644
--- a/checkman.txr
+++ b/checkman.txr
@@ -49,15 +49,15 @@
 @;;
 @(define check-func ())
 @  (cases)
-.coNP Operator/function @(skip)
-@      (assert bad ln `no .synb after Operator/function heading`)
+.coNP @{type /Operator|Macro/}/function @(skip)
+@      (assert bad ln `no .synb after @type/function heading`)
 @      (check-synb)
 @    (or)
 .coNP Operator @@ @op and macro @@ @mac
 @      (assert bad ln `no .synb after Operator and macro heading`)
 @      (check-synb)
 @    (or)
-.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure/}s@(assert bad ln `bad @{type}s heading`)@(rep :gap 0) @@, @{x /\S+/}@(last :mandatory) @@ @y and @@ @{z /\S+/}@(end)
+.coNP @{type /Function|Operator|Macro|Accessor|Method|Structure|(Operators|Macros)\/function/}s@(assert bad ln `bad @{type}s heading`)@(rep :gap 0) @@, @{x /\S+/}@(last :mandatory) @@ @y and @@ @{z /\S+/}@(end)
 @      (assert bad ln `no .synb after @{type}s heading`)
 @      (check-synb)
 @    (or)
diff --git a/eval.c b/eval.c
index 8b0cb0a3..dea5d1d8 100644
--- a/eval.c
+++ b/eval.c
@@ -6068,6 +6068,22 @@ static val and_fun(struct args *vals)
   return item;
 }
 
+static val progn_fun(struct args *vals)
+{
+  return if3(vals->list, car(lastcons(vals->list)), vals->arg[vals->fill - 1]);
+}
+
+static val prog1_fun(struct args *vals)
+{
+  return if2(args_more(vals, 0), args_at(vals, 0));
+}
+
+static val prog2_fun(struct args *vals)
+{
+  args_normalize_least(vals, 2);
+  return if2(vals->fill >= 2, vals->arg[1]);
+}
+
 static val not_null(val obj)
 {
   return if3(nilp(obj), nil, t);
@@ -6738,6 +6754,9 @@ void eval_init(void)
   reg_fun(if_s, func_n3o(if_fun, 2));
   reg_fun(or_s, func_n0v(or_fun));
   reg_fun(and_s, func_n0v(and_fun));
+  reg_fun(progn_s, func_n0v(progn_fun));
+  reg_fun(prog1_s, func_n0v(prog1_fun));
+  reg_fun(prog2_s, func_n0v(prog2_fun));
   reg_fun(intern(lit("retf"), user_package), func_n1(retf));
   reg_fun(intern(lit("apf"), user_package), func_n1v(apf));
   reg_fun(intern(lit("ipf"), user_package), func_n1v(ipf));
diff --git a/txr.1 b/txr.1
index c3aac32a..90e56910 100644
--- a/txr.1
+++ b/txr.1
@@ -15077,7 +15077,7 @@ The entire lexical environment is copied; the copy and original function do not
 share any portion of the environment at any level of nesting.
 
 .SS* Sequencing, Selection and Iteration
-.coNP Operators @ progn and @ prog1
+.coNP Operators/functions @ progn and @ prog1
 .synb
 .mets (progn << form *)
 .mets (prog1 << form *)
@@ -15110,12 +15110,26 @@ 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:"
+These special operators are also functions. The
+.code progn
+function accepts zero or more arguments. It returns its last argument, or
+.code nil
+if called with no arguments. The
+.code prog1
+function likewise accepts zero or more arguments. It returns its first argument, or
+.code nil
+if called with no arguments.
+
+.TP* "Dialect Notes:"
 In ANSI Common Lisp,
 .code prog1
-requires at least one argument.
+requires at least one argument. Neither
+.code prog
+nor
+.code prog1
+exist as functions.
 
-.coNP Macro @ prog2
+.coNP Macro/function @ prog2
 .synb
 .mets (prog2 << form *)
 .syne
@@ -15142,10 +15156,19 @@ and
 yield
 .codn nil .
 
-.TP* "Dialect Note:"
+The
+.code prog2
+symbol also has a function binding. The
+.code prog2
+function accepts any number of arguments. If invoked with at least two arguments,
+it returns the second one. Otherwise it returns
+.codn nil .
+
+.TP* "Dialect Notes:"
 In ANSI Common Lisp,
 .code prog2
 requires at least two arguments.
+It does not exist as a function.
 
 .coNP Operator @ cond
 .synb
-- 
cgit v1.2.3