* eval.c (del_s): New symbol variable.

(eval_error): nostatic added to suppress a g++ warning.
(dwim_loc): Takes new value as the original unevaluated form so
it can control evaluation. Support for del operator added.
(op_modplace): Bugfixes: new value form was being unconditionally
evaluated and out of order w.r.t. other forms. Now there is
left to right order. The form is evaluated later, since for most
operators it is on the right, with the exception of push.
dwim places can now optionally control the evaluation of newform.
del operator supported in gethash case as a special case.
error case added for del: if it's not handled in gethash or
dwim_loc, it is an error.
(eval_init): del_s initialized, and del operator added to table.

* txr.vim: syntax highlighting for del.

* txr.1: Documented del.

4 files changed, 116 insertions, 37 deletions

diff --git a/ChangeLog b/ChangeLog
index 9da05664..9e354cb2 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,25 @@
 2012-02-22  Kaz Kylheku  <kaz@kylheku.com>
 
+	* eval.c (del_s): New symbol variable.
+	(eval_error): nostatic added to suppress a g++ warning.
+	(dwim_loc): Takes new value as the original unevaluated form so
+	it can control evaluation. Support for del operator added.
+	(op_modplace): Bugfixes: new value form was being unconditionally
+	evaluated and out of order w.r.t. other forms. Now there is
+	left to right order. The form is evaluated later, since for most
+	operators it is on the right, with the exception of push.
+	dwim places can now optionally control the evaluation of newform.
+	del operator supported in gethash case as a special case.
+	error case added for del: if it's not handled in gethash or
+	dwim_loc, it is an error.
+	(eval_init): del_s initialized, and del operator added to table.
+
+	* txr.vim: syntax highlighting for del.
+
+	* txr.1: Documented del.
+
+2012-02-22  Kaz Kylheku  <kaz@kylheku.com>
+
 	* lib.c (init): Hash bugfix: added missing call to hash_init.
 	Previously this function did nothing, but now it interns
 	some important symbols.
diff --git a/eval.c b/eval.c
index 30598bb6..e9ab5af3 100644
--- a/eval.c
+++ b/eval.c
@@ -58,7 +58,8 @@ val op_table;
 val eval_error_s;
 val dwim_s, progn_s, prog1_s, let_s, let_star_s, lambda_s, call_s;
 val cond_s, if_s, defvar_s, defun_s;
-val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_s, vecref_s;
+val inc_s, dec_s, push_s, pop_s, flip_s, gethash_s, car_s, cdr_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 dohash_s;
 val uw_protect_s, return_s, return_from_s;
@@ -95,7 +96,7 @@ static void env_replace_vbind(val env, val bindings)
   env->e.vbindings = bindings;
 }
 
-static val eval_error(val form, val fmt, ...)
+noreturn static val eval_error(val form, val fmt, ...)
 {
   va_list vl;
   val stream = make_string_output_stream();
@@ -728,7 +729,7 @@ static val op_defun(val form, val env)
 
 static val op_modplace(val form, val env);
 
-static val *dwim_loc(val form, val env, val op, val newval, val *retval)
+static val *dwim_loc(val form, val env, val op, val newform, val *retval)
 {
   val obj = eval_lisp1(second(form), env, form);
   val args = eval_args_lisp1(rest(rest(form)), env, form);
@@ -747,28 +748,46 @@ static val *dwim_loc(val form, val env, val op, val newval, val *retval)
       val index = first(args);
 
       if (consp(index)) {
-        if (op != set_s) 
-          eval_error(form, lit("[~s ~s]: ranges takes only set assignments"),
+        if (op == set_s) {
+          val newval = eval(newform, env, form);
+          replace_str(obj, newval, car(index), cdr(index));
+          *retval = newval;
+        } else if (op == del_s) {
+          replace_str(obj, nil, car(index), cdr(index));
+          *retval = nil;
+        } else {
+          eval_error(form, lit("[~s ~s]: ranges allow only set and del operators"),
                      obj, index, nao);
+        }
 
-        replace_str(obj, newval, car(index), cdr(index));
-        *retval = newval;
         return 0;
       } else {
         uses_or2;
+
         if (op == set_s) {
-          chr_str_set(obj, index, newval);
+          val newval = eval(newform, env, form);
+          chr_str_set(obj, index, eval(newform, env, form));
+          *retval = newval;
         } else if (op == inc_s) {
-          newval = plus(chr_str(obj, index), or2(newval, one));
+          val newval = plus(chr_str(obj, index),
+                            or2(eval(newform, env, form), one));
           chr_str_set(obj, index, newval);
+          *retval = newval;
         } else if (op == dec_s) {
-          newval = minus(chr_str(obj, index), or2(newval, one));
+          val newval = minus(chr_str(obj, index),
+                             or2(eval(newform, env, form), one));
           chr_str_set(obj, index, newval);
+          *retval = newval;
+        } else if (op == del_s) {
+          if (lt(index, zero) || length_str_le(obj, index))
+            eval_error(form, lit("[~s ~s]: index out of bounds"),
+                                 obj, index, nao);
+          replace_str(obj, nil, index, plus(index, one));
+          *retval = nil;
         } else {
-          eval_error(form, lit("[~s ~s]: only set, inc and dec can be used "
-                               "for string indices"), obj, index, nao);
+          eval_error(form, lit("[~s ~s]: only set, inc, dec and del can be "
+                               "used for string indices"), obj, index, nao);
         }
-        *retval = newval;
         return 0;
       }
     }
@@ -784,12 +803,18 @@ static val *dwim_loc(val form, val env, val op, val newval, val *retval)
       val index = first(args);
 
       if (consp(index)) {
-        if (op != set_s) 
-          eval_error(form, lit("[~s ~s]: ranges take only set assignments"),
-                     obj, index, nao);
 
-        replace_vec(obj, newval, car(index), cdr(index));
-        *retval = newval;
+        if (op == set_s) {
+          val newval = eval(newform, env, form);
+          replace_vec(obj, newval, car(index), cdr(index));
+          *retval = newval;
+        } else if (op == del_s) {
+          replace_vec(obj, nil, car(index), cdr(index));
+          *retval = nil;
+        } else {
+          eval_error(form, lit("[~s ~s]: ranges allow only set and del operators"),
+                     obj, index, nao);
+        }
         return 0;
       } else {
         return vecref_l(obj, first(args));
@@ -810,15 +835,23 @@ static val *dwim_loc(val form, val env, val op, val newval, val *retval)
         val newlist;
         val tempform;
 
-        if (op != set_s) 
-          eval_error(form, lit("[~s ~s]: ranges take only simple assignments"),
-                     cell, index, nao);
-
-        newlist = replace_list(obj, newval, car(index), cdr(index));
-        tempform = list(op, second(form), 
-                        cons(quote_s, cons(newlist, nil)), nao);
-        op_modplace(tempform, env);
-        *retval = newval;
+        if (op == set_s) {
+          val newval = eval(newform, env, form);
+          newlist = replace_list(obj, newval, car(index), cdr(index));
+          tempform = list(op, second(form), 
+                          cons(quote_s, cons(newlist, nil)), nao);
+          op_modplace(tempform, env);
+          *retval = newval;
+        } else if (op == del_s) {
+          newlist = replace_list(obj, nil, car(index), cdr(index));
+          tempform = list(op, second(form), 
+                          cons(quote_s, cons(newlist, nil)), nao);
+          op_modplace(tempform, env);
+          *retval = nil;
+        } else {
+          eval_error(form, lit("[~s ~s]: ranges allow only set and del operators"),
+                     obj, index, nao);
+        }
         return 0;
       } else {
         eval_error(form, lit("[~s ~s]: index must be integer, or pair"),
@@ -832,6 +865,13 @@ static val *dwim_loc(val form, val env, val op, val newval, val *retval)
         if (lt(length(args), one))
           eval_error(form, lit("[~s ...]: hash indexing needs at least one arg"),
                      obj, nao);
+
+        if (op == del_s) {
+          *retval = gethash(obj, first(args));
+          remhash(obj, first(args));
+          return 0;
+        }
+
         loc = gethash_l(obj, first(args), &new_p);
         if (new_p)
           *loc = second(args);
@@ -851,7 +891,8 @@ static val op_modplace(val form, val env)
   val op = first(form);
   val place = second(form);
   val third_arg_p = rest(rest(form));
-  val newval = if3(car(third_arg_p), third(form), nil);
+  val newform = if3(car(third_arg_p), third(form), nil);
+  val newval;
   val *loc = 0;
 
   if (op == push_s) {
@@ -859,11 +900,10 @@ static val op_modplace(val form, val env)
     if (!third_arg_p)
       eval_error(form, lit("~a: missing argument"), op, place, nao);
     place = third(form);
-    newval = tmp;
+    newform = tmp;
+    newval = eval(newform, env, form);
   }
 
-  newval = eval(newval, env, form);
-
   if (symbolp(place)) {
     if (!bindable(place))
       eval_error(form, lit("~a: ~s is not a bindable sybol"), op, place, nao);
@@ -875,13 +915,18 @@ static val op_modplace(val form, val env)
     val sym = car(place);
     if (sym == dwim_s) {
       val ret = nil;
-      loc = dwim_loc(place, env, op, newval, &ret);
+      loc = dwim_loc(place, env, op, newform, &ret);
       if (loc == 0)
         return ret;
     } else if (sym == gethash_s) {
       val hash = eval(second(place), env, form);
       val key = eval(third(place), env, form);
       val new_p;
+      if (op == del_s) {
+        val ret = gethash(hash, key);
+        remhash(hash, key);
+        return ret;
+      }
       loc = gethash_l(hash, key, &new_p);
       if (new_p)
         *loc = eval(fourth(place), env, form);
@@ -909,12 +954,12 @@ static val op_modplace(val form, val env)
   if (op == set_s) {
     if (!third_arg_p)
       eval_error(form, lit("~a: missing argument"), op, place, nao);
-    return *loc = newval;
+    return *loc = eval(newform, env, form);
   } else if (op == inc_s) {
-    val inc = or2(newval, one);
+    val inc = or2(eval(newform, env, form), one);
     return *loc = plus(*loc, inc);
   } else if (op == dec_s) {
-    val inc = or2(newval, one);
+    val inc = or2(eval(newform, env, form), one);
     return *loc = minus(*loc, inc);
   } else if (op == push_s) {
     return push(newval, loc);
@@ -924,6 +969,8 @@ static val op_modplace(val form, val env)
     return pop(loc);
   } else if (op == flip_s) {
     return *loc = nullp(*loc);
+  } else if (op == del_s) {
+    eval_error(form, lit("~a: cannot delete ~a"), op, place, nao);
   }
 
   internal_error("unhandled place modifier");
@@ -1963,6 +2010,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);
+  del_s = intern(lit("del"), user_package);
   for_s = intern(lit("for"), user_package);
   for_star_s = intern(lit("for*"), user_package);
   each_s = intern(lit("each"), user_package);
@@ -2013,6 +2061,7 @@ void eval_init(void)
   sethash(op_table, push_s, cptr((mem_t *) op_modplace));
   sethash(op_table, pop_s, cptr((mem_t *) op_modplace));
   sethash(op_table, flip_s, cptr((mem_t *) op_modplace));
+  sethash(op_table, del_s, cptr((mem_t *) op_modplace));
   sethash(op_table, for_s, cptr((mem_t *) op_for));
   sethash(op_table, for_star_s, cptr((mem_t *) op_for));
   sethash(op_table, dohash_s, cptr((mem_t *) op_dohash));
diff --git a/txr.1 b/txr.1
index 629b8b4b..ca8dacbd 100644
--- a/txr.1
+++ b/txr.1
@@ -4875,7 +4875,7 @@ possible to terminate the function and return a value using (return-from <name>
 
 A function may call itself by name, allowing for recursion.
 
-.SS Operators inc, dec, set, push, pop and flip
+.SS Operators inc, dec, set, push, pop, flip and del
 
 .TP
 Syntax:
@@ -4886,6 +4886,7 @@ Syntax:
   (push <item> <place>)
   (pop <place>)
   (flip <place>)
+  (del <place>)
 
 .TP
 Description:
@@ -4938,6 +4939,15 @@ The flip operator toggles a place between true and false. If the place
 contains a value other than nil, then its value is replaced with nil.
 If it contains nil, it is replaced with t.
 
+The 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 dwim operator
+indexing notation can be subject to a deletion, as can hash table entries
+denoted using dwim or gethash. It is an error to try to delete other kinds of
+places such as simple variables. The del operator returns the value of the
+place that was deleted. Deleting from a sequence means removing the element or
+elements. Deleting a hash place means removing the corresponding entry from the
+hash table.
+
 Currently, these forms are recognized as places:
 
   <symbol>
diff --git a/txr.vim b/txr.vim
index 928b5b66..2a157c71 100644
--- a/txr.vim
+++ b/txr.vim
@@ -27,7 +27,7 @@ syn keyword txr_keyword contained defex throw deffilter filter eof eol do
 
 syn keyword txl_keyword contained progn prog1 let syn let* lambda call fun 
 syn keyword txl_keyword contained cond if and or dwim op catch
-syn keyword txl_keyword contained defvar defun inc dec set push pop flip
+syn keyword txl_keyword contained defvar defun inc dec set push pop flip del
 syn keyword txl_keyword contained for for* dohash unwind-protect block
 syn keyword txl_keyword contained return return-from gen delay
 syn keyword txl_keyword contained each each* collect-each collect-each*