New zap operator.

* eval.c (zap_s): New global variable.
(op_modplace): Support zap.
(eval_init): Initialize zap_s, and register as operator.

* txr.1: Documented zap.

3 files changed, 40 insertions, 2 deletions

diff --git a/ChangeLog b/ChangeLog
index 4d1e89a1..dac4784b 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2015-04-01  Kaz Kylheku  <kaz@kylheku.com>
+
+	New zap operator.
+
+	* eval.c (zap_s): New global variable.
+	(op_modplace): Support zap.
+	(eval_init): Initialize zap_s, and register as operator.
+
+	* txr.1: Documented zap.
+
 2015-03-31  Kaz Kylheku  <kaz@kylheku.com>
 
 	Array overrun fix in apply.
diff --git a/eval.c b/eval.c
index 0807f834..2bd4121d 100644
--- a/eval.c
+++ b/eval.c
@@ -70,7 +70,7 @@ val cond_s, if_s, defvar_s, defun_s, defmacro_s, tree_case_s, tree_bind_s;
 val caseq_s, caseql_s, casequal_s;
 val memq_s, memql_s, memqual_s;
 val eq_s, eql_s, equal_s;
-val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, not_s;
+val inc_s, dec_s, push_s, pop_s, flip_s, zap_s, gethash_s, car_s, cdr_s, not_s;
 val del_s, vecref_s;
 val for_s, for_star_s, each_s, each_star_s, collect_each_s, collect_each_star_s;
 val append_each_s, append_each_star_s;
@@ -1886,6 +1886,10 @@ static val op_modplace(val form, val env)
     return pop(valptr(ptr));
   } else if (op == flip_s) {
     return deref(ptr) = null(deref(ptr));
+  } else if (op == zap_s) {
+    val oldval = deref(ptr);
+    set(ptr, eval(newform, env, form));
+    return oldval;
   } else if (op == del_s) {
     eval_error(form, lit("~s: cannot delete ~a"), op, place, nao);
   }
@@ -3770,6 +3774,7 @@ void eval_init(void)
   push_s = intern(lit("push"), user_package);
   pop_s = intern(lit("pop"), user_package);
   flip_s = intern(lit("flip"), user_package);
+  zap_s = intern(lit("zap"), user_package);
   del_s = intern(lit("del"), user_package);
   for_s = intern(lit("for"), user_package);
   for_star_s = intern(lit("for*"), user_package);
@@ -3860,6 +3865,7 @@ void eval_init(void)
   reg_op(push_s, op_modplace);
   reg_op(pop_s, op_modplace);
   reg_op(flip_s, op_modplace);
+  reg_op(zap_s, op_modplace);
   reg_op(del_s, op_modplace);
   reg_op(for_s, op_for);
   reg_op(for_star_s, op_for);
diff --git a/txr.1 b/txr.1
index ba159f56..d5290c81 100644
--- a/txr.1
+++ b/txr.1
@@ -10837,7 +10837,7 @@ functions whose arguments are constant forms.
 
 .SS* Mutation
 
-.coNP Operators @ inc @ dec @ set @ push @ pop @ flip and @ del
+.coNP Operators @, inc @, dec @, set @, push @, pop @, flip @, zap and @ del
 .synb
 .mets (inc < place <> [ delta ])
 .mets (dec < place <> [ delta ])
@@ -10845,6 +10845,7 @@ functions whose arguments are constant forms.
 .mets (push < item << place )
 .mets (pop << place )
 .mets (flip << place )
+.mets (zap << place <> [ new-value ])
 .mets (del << place )
 .syne
 .desc
@@ -10941,6 +10942,27 @@ it is replaced with
 .codn t .
 
 The
+.code zap
+operator is similar to
+.code set
+except that
+.meta new-value
+is optional, defaulting to
+.codn nil ,
+and the operator returns the previous value of the place.
+This operator is useful in avoiding spurious retention of memory in the
+face of garbage collection. The idiom
+.code (function (zap variable))
+passes the value of
+.code variable
+to
+.code function
+while at the same time clearing it to
+.codn nil . This means that the caller no longer has a reference to the
+contents of the variable as far as the garbage collector is concerned.
+This approach is essential in some uses of infinite, lazy objects.
+
+The
 .code del
 operator does not modify the value of a place, but rather deletes the
 place itself. Index values and ranges of lists denoted using the