Fixing issue with list-like iteration over generic sequences,

namely that empty strings and vectors are not nil.
The nullify function is introduced. It is also exposed to
users, as is the existing make_like function.

* eval.c (mapcarv, mappendv, lazy_mapcar, lazy_mapcarv):
Use nullify to handle non-list inputs correctly.
(eval_init): Registering make_like and nullify as intrinsics.

* lib.c (copy_list, to_seq, list_collect_nconc, list_collect_append,
reverse, lazy_appendv_func, lazy_appendv, ldiff, memq, memql,
memqual, remq, remql, remqual, remove_if, keep_if, rem_lazy_rec,
remq_lazy, remql_lazy, remqual_lazy, remove_if_lazy, keep_if_lazy,
countqual, countql, countq, count_if, some_satisfy, all_satisfy,
none_satisfy, do_chain, chainv, do_and, andv, do_or, orv,
cat_vec, assoc, assql, mapcar, mapcon, mappend, sort, multi_sort,
find, find_if, posqual, posql, posq, pos, pos_if, set_diff,
search): Use nullify for correctness. Some functions fixed
so return sequence matches type of input sequence.
(nullify): New function.

* lib.h (nullify): Declared.

* txr.1: Documented nullify and ake-like.

5 files changed, 195 insertions, 22 deletions

diff --git a/ChangeLog b/ChangeLog
index d792a7d9..1087931d 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,32 @@
 2014-06-06  Kaz Kylheku  <kaz@kylheku.com>
 
+	Fixing issue with list-like iteration over generic sequences,
+	namely that empty strings and vectors are not nil.
+	The nullify function is introduced. It is also exposed to
+	users, as is the existing make_like function.
+
+	* eval.c (mapcarv, mappendv, lazy_mapcar, lazy_mapcarv):
+	Use nullify to handle non-list inputs correctly.
+	(eval_init): Registering make_like and nullify as intrinsics.
+
+	* lib.c (copy_list, to_seq, list_collect_nconc, list_collect_append,
+	reverse, lazy_appendv_func, lazy_appendv, ldiff, memq, memql,
+	memqual, remq, remql, remqual, remove_if, keep_if, rem_lazy_rec,
+	remq_lazy, remql_lazy, remqual_lazy, remove_if_lazy, keep_if_lazy,
+	countqual, countql, countq, count_if, some_satisfy, all_satisfy,
+	none_satisfy, do_chain, chainv, do_and, andv, do_or, orv,
+	cat_vec, assoc, assql, mapcar, mapcon, mappend, sort, multi_sort,
+	find, find_if, posqual, posql, posq, pos, pos_if, set_diff,
+	search): Use nullify for correctness. Some functions fixed
+	so return sequence matches type of input sequence.
+	(nullify): New function.
+
+	* lib.h (nullify): Declared.
+
+	* txr.1: Documented nullify and ake-like.
+
+2014-06-06  Kaz Kylheku  <kaz@kylheku.com>
+
 	* eval.c (eval_init): Register new search function as intrinsic.
 
 	* lib.c (search_list): New static function.
diff --git a/eval.c b/eval.c
index a4f320ab..068e1a9e 100644
--- a/eval.c
+++ b/eval.c
@@ -2651,9 +2651,9 @@ static val macroexpand(val form, val menv)
 val mapcarv(val fun, val list_of_lists)
 {
   if (!cdr(list_of_lists)) {
-    return mapcar(fun, car(list_of_lists));
+    return mapcar(fun, nullify(car(list_of_lists)));
   } else {
-    val lofl = copy_list(list_of_lists);
+    val lofl = mapcar(func_n1(nullify), list_of_lists);
     val list_orig = car(list_of_lists);
     list_collect_decl (out, otail);
 
@@ -2679,7 +2679,7 @@ static val mappendv(val fun, val list_of_lists)
   if (!cdr(list_of_lists)) {
     return mappend(fun, car(list_of_lists));
   } else {
-    val lofl = copy_list(list_of_lists);
+    val lofl = mapcar(func_n1(nullify), list_of_lists);
     val list_orig = car(list_of_lists);
     list_collect_decl (out, otail);
 
@@ -2716,6 +2716,7 @@ static val lazy_mapcar_func(val env, val lcons)
 
 val lazy_mapcar(val fun, val list)
 {
+  list = nullify(list);
   if (!list)
     return nil;
   return make_lazy_cons(func_f1(cons(fun, list), lazy_mapcar_func));
@@ -2744,7 +2745,7 @@ static val lazy_mapcarv(val fun, val list_of_lists)
   } else if (some_satisfy(list_of_lists, null_f, identity_f)) {
     return nil;
   } else {
-    val lofl = copy_list(list_of_lists);
+    val lofl = mapcar(func_n1(nullify), list_of_lists);
     return make_lazy_cons(func_f1(cons(fun, lofl), lazy_mapcarv_func));
   }
 }
@@ -3530,6 +3531,9 @@ void eval_init(void)
   reg_fun(intern(lit("update"), user_package), func_n2(update));
   reg_fun(intern(lit("search"), user_package), func_n4o(search, 2));
 
+  reg_fun(intern(lit("make-like"), user_package), func_n2(make_like));
+  reg_fun(intern(lit("nullify"), user_package), func_n1(nullify));
+
   reg_fun(intern(lit("symbol-value"), user_package), func_n1(symbol_value));
   reg_fun(intern(lit("symbol-function"), user_package), func_n1(symbol_function));
   reg_fun(intern(lit("boundp"), user_package), func_n1(boundp));
diff --git a/lib.c b/lib.c
index a459f44f..d46ab2e6 100644
--- a/lib.c
+++ b/lib.c
@@ -448,10 +448,13 @@ val push(val value, val *plist)
   /* Unsafe for mutating object fields: use mpush macro. */
   return *plist = cons(value, *plist);
 }
+
 val copy_list(val list)
 {
   list_collect_decl (out, ptail);
 
+  list = nullify(list);
+
   while (consp(list)) {
     ptail = list_collect(ptail, car(list));
     list = cdr(list);
@@ -495,7 +498,7 @@ val to_seq(val seq)
   case NIL:
   case CONS:
   case LCONS:
-    return seq;
+    return nullify(seq);
   default:
     return cons(seq, nil);
   }
@@ -518,6 +521,26 @@ val tolist(val seq)
   }
 }
 
+val nullify(val seq)
+{
+  switch (type(seq)) {
+  case NIL:
+    return nil;
+  case CONS:
+  case LCONS:
+    return seq;
+  case LIT:
+  case STR:
+    return c_str(seq)[0] ? seq : nil;
+  case LSTR:
+    return if3(length_str_gt(seq, zero), seq, nil);
+  case VEC:
+    return if3(length_vec(seq) != zero, seq, nil);
+  default:
+    return seq;
+  }
+}
+
 loc list_collect(loc ptail, val obj)
 {
   switch (type(deref(ptail))) {
@@ -544,6 +567,8 @@ loc list_collect(loc ptail, val obj)
 
 loc list_collect_nconc(loc ptail, val obj)
 {
+  obj = nullify(obj);
+
   switch (type(deref(ptail))) {
   case NIL:
     set(ptail, obj);
@@ -568,6 +593,8 @@ loc list_collect_nconc(loc ptail, val obj)
 
 loc list_collect_append(loc ptail, val obj)
 {
+  obj = nullify(obj);
+
   switch (type(deref(ptail))) {
   case NIL:
     set(ptail, obj);
@@ -612,6 +639,8 @@ val reverse(val in)
   val in_orig = in;
   val rev = nil;
 
+  in = nullify(in);
+
   while (in) {
     rev = cons(car(in), rev);
     in = cdr(in);
@@ -769,7 +798,7 @@ static val lazy_appendv_func(val env, val lcons)
   val nonempty = nil;
 
   while (lists) {
-    nonempty = pop(&lists);
+    nonempty = nullify(pop(&lists));
     if (nonempty)
       break;
   }
@@ -797,7 +826,7 @@ val lazy_appendv(val lists)
   val nonempty = nil;
 
   while (lists) {
-    nonempty = pop(&lists);
+    nonempty = nullify(pop(&lists));
     if (nonempty)
       break;
   }
@@ -815,8 +844,12 @@ val lazy_appendv(val lists)
 
 val ldiff(val list1, val list2)
 {
+  val list_orig = list1;
   list_collect_decl (out, ptail);
 
+  list1 = nullify(list1);
+  list2 = nullify(list2);
+
   switch (type(list2)) {
   case STR:
   case LIT:
@@ -835,28 +868,34 @@ val ldiff(val list1, val list2)
     break;
   }
 
-  return out;
+  return make_like(out, list_orig);
 }
 
 val memq(val obj, val list)
 {
+  val list_orig = list;
+  list = nullify(list);
   while (list && car(list) != obj)
     list = cdr(list);
-  return list;
+  return make_like(list, list_orig);
 }
 
 val memql(val obj, val list)
 {
+  val list_orig = list;
+  list = nullify(list);
   while (list && !eql(car(list), obj))
     list = cdr(list);
-  return list;
+  return make_like(list, list_orig);
 }
 
 val memqual(val obj, val list)
 {
+  val list_orig = list;
+  list = nullify(list);
   while (list && !equal(car(list), obj))
     list = cdr(list);
-  return list;
+  return make_like(list, list_orig);
 }
 
 val remq(val obj, val list)
@@ -865,6 +904,8 @@ val remq(val obj, val list)
   val list_orig = list;
   val lastmatch = cons(nil, list);
 
+  list = nullify(list);
+
   for (; list; list = cdr(list)) {
     if (car(list) == obj) {
       ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
@@ -881,6 +922,8 @@ val remql(val obj, val list)
   val list_orig = list;
   val lastmatch = cons(nil, list);
 
+  list = nullify(list);
+
   for (; list; list = cdr(list)) {
     if (eql(car(list), obj)) {
       ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
@@ -897,6 +940,8 @@ val remqual(val obj, val list)
   val list_orig = list;
   val lastmatch = cons(nil, list);
 
+  list = nullify(list);
+
   for (; list; list = cdr(list)) {
     if (equal(car(list), obj)) {
       ptail = list_collect_nconc(ptail, ldiff(cdr(lastmatch), list));
@@ -915,6 +960,8 @@ val remove_if(val pred, val list, val key)
 
   key = default_arg(key, identity_f);
 
+  list = nullify(list);
+
   for (; list; list = cdr(list)) {
     val subj = funcall1(key, car(list));
     val satisfies = funcall1(pred, subj);
@@ -936,6 +983,8 @@ val keep_if(val pred, val list, val key)
 
   key = default_arg(key, identity_f);
 
+  list = nullify(list);
+
   for (; list; list = cdr(list)) {
     val subj = funcall1(key, car(list));
     val satisfies = funcall1(pred, subj);
@@ -972,29 +1021,29 @@ static val rem_lazy_rec(val pred, val list, val env, val func)
 
 val remq_lazy(val obj, val list)
 {
-  return rem_lazy_rec(curry_12_1(eq_f, obj), list, nil, nil);
+  return rem_lazy_rec(curry_12_1(eq_f, obj), nullify(list), nil, nil);
 }
 
 val remql_lazy(val obj, val list)
 {
-  return rem_lazy_rec(curry_12_1(eql_f, obj), list, nil, nil);
+  return rem_lazy_rec(curry_12_1(eql_f, obj), nullify(list), nil, nil);
 }
 
 val remqual_lazy(val obj, val list)
 {
-  return rem_lazy_rec(curry_12_1(equal_f, obj), list, nil, nil);
+  return rem_lazy_rec(curry_12_1(equal_f, obj), nullify(list), nil, nil);
 }
 
 val remove_if_lazy(val pred, val list, val key)
 {
   val pred_key = chain(default_arg(key, identity_f), pred, nao);
-  return rem_lazy_rec(pred_key, list, nil, nil);
+  return rem_lazy_rec(pred_key, nullify(list), nil, nil);
 }
 
 val keep_if_lazy(val pred, val list, val key)
 {
   val pred_key = chain(default_arg(key, identity_f), pred, null_f, nao);
-  return rem_lazy_rec(pred_key, list, nil, nil);
+  return rem_lazy_rec(pred_key, nullify(list), nil, nil);
 }
 
 val tree_find(val obj, val tree, val testfun)
@@ -1011,6 +1060,8 @@ val countqual(val obj, val list)
 {
   val count = zero;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list))
     if (equal(car(list), obj))
       count = plus(count, one);
@@ -1022,6 +1073,8 @@ val countql(val obj, val list)
 {
   val count = zero;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list))
     if (eql(car(list), obj))
       count = plus(count, one);
@@ -1033,6 +1086,8 @@ val countq(val obj, val list)
 {
   val count = zero;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list))
     if (car(list) == obj)
       count = plus(count, one);
@@ -1045,6 +1100,7 @@ val count_if(val pred, val list, val key)
   val count = zero;
 
   key = default_arg(key, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list)) {
     val subj = funcall1(key, car(list));
@@ -1061,6 +1117,7 @@ val some_satisfy(val list, val pred, val key)
 {
   pred = default_arg(pred, identity_f);
   key = default_arg(key, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list)) {
     val item;
@@ -1077,6 +1134,7 @@ val all_satisfy(val list, val pred, val key)
 
   pred = default_arg(pred, identity_f);
   key = default_arg(key, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list)) {
     if ((item = funcall1(pred, funcall1(key, car(list)))) == nil)
@@ -1090,6 +1148,7 @@ val none_satisfy(val list, val pred, val key)
 {
   pred = default_arg(pred, identity_f);
   key = default_arg(key, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list)) {
     if (funcall1(pred, funcall1(key, car(list))))
@@ -3744,6 +3803,8 @@ static val do_chain(val fun1_list, val args)
 {
   val arg = nil;
 
+  fun1_list = nullify(fun1_list);
+
   if (fun1_list) {
     arg = apply(car(fun1_list), args, nil);
     fun1_list = cdr(fun1_list);
@@ -3776,11 +3837,13 @@ val chain(val first_fun, ...)
 
 val chainv(val funlist)
 {
-  return func_f0v(funlist, do_chain);
+  return func_f0v(nullify(funlist), do_chain);
 }
 
 static val do_and(val fun1_list, val args)
 {
+  fun1_list = nullify(fun1_list);
+
   for (; fun1_list; fun1_list = cdr(fun1_list))
     if (nilp(apply(car(fun1_list), args, nil)))
       return nil;
@@ -3809,7 +3872,7 @@ val andf(val first_fun, ...)
 
 val andv(val funlist)
 {
-  return func_f0v(funlist, do_and);
+  return func_f0v(nullify(funlist), do_and);
 }
 
 static val do_swap_12_21(val fun, val left, val right)
@@ -3824,6 +3887,8 @@ val swap_12_21(val fun)
 
 static val do_or(val fun1_list, val args)
 {
+  fun1_list = nullify(fun1_list);
+
   for (; fun1_list; fun1_list = cdr(fun1_list))
     if (apply(car(fun1_list), args, nil))
       return t;
@@ -3852,7 +3917,7 @@ val orf(val first_fun, ...)
 
 val orv(val funlist)
 {
-  return func_f0v(funlist, do_or);
+  return func_f0v(nullify(funlist), do_or);
 }
 
 static val do_iff(val env, val args)
@@ -4157,6 +4222,8 @@ val cat_vec(val list)
   val iter;
   val vec, *v;
 
+  list = nullify(list);
+
   for (iter = list; iter != nil; iter = cdr(iter)) {
     size_t newtot = total + c_num(length_vec(car(iter)));
     if (newtot < total)
@@ -4466,6 +4533,8 @@ mem_t *cptr_get(val cptr)
 
 val assoc(val key, val list)
 {
+  list = nullify(list);
+
   while (list) {
     val elem = car(list);
     if (equal(car(elem), key))
@@ -4478,6 +4547,8 @@ val assoc(val key, val list)
 
 val assql(val key, val list)
 {
+  list = nullify(list);
+
   while (list) {
     val elem = car(list);
     if (eql(car(elem), key))
@@ -4610,6 +4681,8 @@ val mapcar(val fun, val list)
   list_collect_decl (out, iter);
   val list_orig = list;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list))
     iter = list_collect(iter, funcall1(fun, car(list)));
 
@@ -4621,6 +4694,8 @@ val mapcon(val fun, val list)
   list_collect_decl (out, iter);
   val list_orig = list;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list))
     iter = list_collect_nconc(iter, funcall1(fun, list));
 
@@ -4632,6 +4707,8 @@ val mappend(val fun, val list)
   list_collect_decl (out, iter);
   val list_orig = list;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list))
     iter = list_collect_append(iter, funcall1(fun, car(list)));
 
@@ -4743,10 +4820,13 @@ static void sort_vec(val vec, val lessfun, val keyfun)
   quicksort(vec, lessfun, keyfun, 0, len);
 }
 
-val sort(val seq, val lessfun, val keyfun)
+val sort(val seq_in, val lessfun, val keyfun)
 {
+  val seq_orig = seq_in;
+  val seq = nullify(seq_in);
+
   if (!seq)
-    return nil;
+    return make_like(nil, seq_orig);
 
   keyfun = default_arg(keyfun, identity_f);
 
@@ -4787,7 +4867,7 @@ static val multi_sort_less(val funcs_cons, val llist, val rlist)
 
 val multi_sort(val lists, val funcs, val key_funcs)
 {
-  val tuples = mapcarv(func_n0v(identity), lists);
+  val tuples = mapcarv(func_n0v(identity), nullify(lists));
 
   key_funcs = default_bool_arg(key_funcs);
 
@@ -4805,6 +4885,8 @@ val find(val item, val list, val testfun, val keyfun)
   testfun = default_arg(testfun, equal_f);
   keyfun = default_arg(keyfun, identity_f);
 
+  list = nullify(list);
+
   for (; list; list = cdr(list)) {
     val elem = car(list);
     val key = funcall1(keyfun, elem);
@@ -4819,6 +4901,7 @@ val find(val item, val list, val testfun, val keyfun)
 val find_if(val pred, val list, val key)
 {
   key = default_arg(key, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list)) {
     val item = car(list);
@@ -4835,6 +4918,8 @@ val posqual(val obj, val list)
 {
   val pos = zero;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list), pos = plus(pos, one))
     if (equal(car(list), obj))
       return pos;
@@ -4846,6 +4931,8 @@ val posql(val obj, val list)
 {
   val pos = zero;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list), pos = plus(pos, one))
     if (eql(car(list), obj))
       return pos;
@@ -4857,6 +4944,8 @@ val posq(val obj, val list)
 {
   val pos = zero;
 
+  list = nullify(list);
+
   for (; list; list = cdr(list), pos = plus(pos, one))
     if (car(list) == obj)
       return pos;
@@ -4869,6 +4958,7 @@ val pos(val item, val list, val testfun, val keyfun)
   val pos = zero;
   testfun = default_arg(testfun, equal_f);
   keyfun = default_arg(keyfun, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list), pos = plus(pos, one)) {
     val elem = car(list);
@@ -4886,6 +4976,7 @@ val pos_if(val pred, val list, val key)
 {
   val pos = zero;
   key = default_arg(key, identity_f);
+  list = nullify(list);
 
   for (; list; list = cdr(list), pos = plus(pos, one)) {
     val item = car(list);
@@ -4903,6 +4994,9 @@ val set_diff(val list1, val list2, val testfun, val keyfun)
   list_collect_decl (out, ptail);
   val list_orig = list1;
 
+  list1 = nullify(list1);
+  list2 = nullify(list2);
+
   testfun = default_arg(testfun, equal_f);
   keyfun = default_arg(keyfun, identity_f);
 
@@ -5152,6 +5246,7 @@ val search(val seq, val key, val testfun, val keyfun)
 {
   testfun = default_arg(testfun, equal_f);
   keyfun = default_arg(keyfun, identity_f);
+  seq = nullify(seq);
 
   switch (type(seq)) {
   case NIL:
diff --git a/lib.h b/lib.h
index c67866c8..4f652e6d 100644
--- a/lib.h
+++ b/lib.h
@@ -427,6 +427,7 @@ val copy_list(val list);
 val make_like(val list, val thatobj);
 val to_seq(val obj);
 val tolist(val seq);
+val nullify(val seq);
 val nreverse(val in);
 val reverse(val in);
 val append2(val list1, val list2);
diff --git a/txr.1 b/txr.1
index e34c5118..66698a38 100644
--- a/txr.1
+++ b/txr.1
@@ -10048,6 +10048,52 @@ The sort function is stable for sequences which are lists. This means that the
 original order of items which are considered identical is preserved.
 For strings and vectors, the sort is not stable.
 
+.SS Function make-like
+
+.TP
+Syntax:
+
+  (make-like <list> <ref-sequence>)
+
+.TP
+Description:
+
+The <list> argument must be a list.  If <ref-sequence> is a sequence type,
+then <list> is converted to the same type of sequence and returned.
+Otherwise the original <list> is returned.
+
+Note: the make-like function is a helper which supports the development of
+unoptimized versions of a generic function that accepts any type of
+sequence as input, and produces a sequence of the same type as output.
+The implementation of such a function can internally accumulate a list, and
+then convert the resulting list to the same type as an input value
+by using make-like.
+
+.SS Function nullify
+
+.TP
+Syntax:
+
+  (nullify <sequence>)
+
+.TP
+Description:
+
+The nullify function returns nil if <sequence> is an empty sequence.
+Otherwise it returns <sequence> itself.
+
+Note: the nullify function is a helper to support unoptimized generic
+programming over sequences.  Thanks to the generic behavior cdr, any
+sequence can be traversed using cdr functions, checking for the nil
+value as a terminator.  This, however, breaks for empty sequences which are not
+lists, because they are not equal to nil: to car and cdr they look like
+a one-element sequence containing nil. The nullify function reduces all empty
+sequences to nil, thereby correcting the behavior of code which traverses
+sequences using cdr, and tests for termination with nil.
+
+.TP
+
+
 .SH MATH LIBRARY
 
 .SS Arithmetic functions +, -