New macro-based framework for assignment places.

The operators set, inc, dec, pop and others are now macros
which generate code, rather than built-in special forms
that use "C magic".  Moreover, new such macros are easy to write, and
several new ones are already available.  Moreover, new kinds of
assignable places are easy to create.

* place.tl: New file.

* lisplib.c, lisplib.h: New files.

* Makefile (OBJS): New target, lisplib.o.
(GEN_HDRS): New variable.
(LISP_TO_C_STRING): New recipe macro, with rule.
(clean): Remove generated headers named in $(GEN_HDRS).

* eval.c (dec_s, push_s, pop_s, flip_s, del_s): Variables removed.
(setq_s): New variable.
(lookup_var, lokup_sym_lisp_1, lookup_var_l, lookup_fun, lookup_mac,
lookup_symac, lookup_symac_lisp1): Trigger the delayed loading of
libraries for undefined global symbols, and re-try the lookup.
(op_modplace, dwim_loc, force_l): Static functions removed.
(op_setq): New static function.
(eval_init): Initialize setq_s; remove initializations of
removed variables; remove registrations for op_modplace;
add registration for sys:setq, sys:rplaca, sys:rplacd,
sys:dwim-set and sys:dwim-del intrinsics.
Call lisplib_init to initialize the dynamic library loading module.

* lib.c (sys_rplaca, sys_rplacd): New functions, differing
in return value from rplaca and rplacd.
(ref, refset): Handle hash table.
(dwim_set, dwim_del): New functions.

* lib.h (sys_rplaca, sys_rplacd, dwim_set, dwim_del): Declared.

* genvim.txr: Include place.tl in scan.

* tests/010/seq.txr: The del operator test
case no longer throws at run-time but at macro-expansion time, so the
test case is simply removed.

* tests/010/seq.expected: Updated output.

* tests/011/macros-2.txr: Reset *gensym-counter* to zero, because
the textual output of the test case includes gensyms, whose numberings
fluctuate with the content of the new Lisp library material.

* tests/011/macros-2.expected: Updated output.

1 files changed, 50 insertions, 1 deletions

diff --git a/lib.c b/lib.c
index 0503d615..e9f4b630 100644
--- a/lib.c
+++ b/lib.c
@@ -288,7 +288,6 @@ val rplaca(val cons, val new_car)
   }
 }
 
-
 val rplacd(val cons, val new_cdr)
 {
   switch (type(cons)) {
@@ -303,6 +302,18 @@ val rplacd(val cons, val new_cdr)
   }
 }
 
+val sys_rplaca(val cons, val new_car)
+{
+  (void) rplaca(cons, new_car);
+  return new_car;
+}
+
+val sys_rplacd(val cons, val new_car)
+{
+  (void) rplacd(cons, new_car);
+  return new_car;
+}
+
 loc car_l(val cons)
 {
   switch (type(cons)) {
@@ -6269,6 +6280,9 @@ val ref(val seq, val ind)
     return chr_str(seq, ind);
   case VEC:
     return vecref(seq, ind);
+  case COBJ:
+    if (seq->co.cls == hash_s)
+      return gethash(seq, ind);
   default:
     type_mismatch(lit("ref: ~s is not a sequence"), seq, nao);
   }
@@ -6287,6 +6301,9 @@ val refset(val seq, val ind, val newval)
     return chr_str_set(seq, ind, newval);
   case VEC:
     return set(vecref_l(seq, ind), newval);
+  case COBJ:
+    if (seq->co.cls == hash_s)
+      return sethash(seq, ind, newval);
   default:
     type_mismatch(lit("ref: ~s is not a sequence"), seq, nao);
   }
@@ -6311,6 +6328,38 @@ val replace(val seq, val items, val from, val to)
   }
 }
 
+val dwim_set(val seq, val ind_range, val newval)
+{
+  if (consp(ind_range)) {
+    cons_bind (x, y, ind_range);
+
+    if (atom(y))
+      return replace(seq, newval, x, y);
+    return replace(seq, newval, ind_range, colon_k);
+  } else if (vectorp(ind_range)) {
+    return replace(seq, newval, ind_range, colon_k);
+  } else{
+    (void) refset(seq, ind_range, newval);
+    return seq;
+  }
+
+  return newval;
+}
+
+val dwim_del(val seq, val ind_range)
+{
+  if (consp(ind_range)) {
+    return replace(seq, nil, car(ind_range), cdr(ind_range));
+  } else {
+    if (hashp(seq)) {
+      (void) remhash(seq, ind_range);
+      return seq;
+    } else {
+      return replace(seq, nil, ind_range, succ(ind_range));
+    }
+  }
+}
+
 val update(val seq, val fun)
 {
   switch (type(seq)) {