summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2021-01-01 13:57:38 -0800
committerKaz Kylheku <kaz@kylheku.com>2021-01-01 13:57:38 -0800
commitdf9904609a72052b1014f48e4de8fa1baa74fc94 (patch)
tree4fd4f17d630ca6baaba4de89757c9de70db07174
parentf9f8b1cc48212450fd200cc517b8f9ed932e1cb9 (diff)
downloadtxr-df9904609a72052b1014f48e4de8fa1baa74fc94.tar.gz
txr-df9904609a72052b1014f48e4de8fa1baa74fc94.tar.bz2
txr-df9904609a72052b1014f48e4de8fa1baa74fc94.zip
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.
-rw-r--r--checkman.txr6
-rw-r--r--eval.c19
-rw-r--r--txr.133
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