summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2014-06-15 20:54:52 -0700
committerKaz Kylheku <kaz@kylheku.com>2014-06-15 20:54:52 -0700
commit548dd7697516a2fea8930d3fa9e88ea48d5ab630 (patch)
treebe6c1d61f3e1e982a5451007a2f95a4a2ad693ab
parent9127cdb5d591d2a10919dc9fa2c75f9e44a1d093 (diff)
downloadtxr-548dd7697516a2fea8930d3fa9e88ea48d5ab630.tar.gz
txr-548dd7697516a2fea8930d3fa9e88ea48d5ab630.tar.bz2
txr-548dd7697516a2fea8930d3fa9e88ea48d5ab630.zip
* eval.c (eval_init): Register pos_max, pos_min, find_max,
find_min and seqp as intrinsics. * lib.c (gt_f, lt_f): New variables. (to_seq): renamed to toseq. (seqp): New function. (minmax): New static function. (replace_str, replace_vec): Follow to_seq renaming. (find_max, find_min, pos_max, pos_min): New functions. (obj_init): gc-protect and initialize gt_f and lt_f. * lib.h (gt_f, lt_f): Declared. (to_seq): Declaration updated to toseq. (seqp, find_max, find_min, pos_max, pos_min): Declared. * txr.1: Updated.
-rw-r--r--ChangeLog20
-rw-r--r--eval.c5
-rw-r--r--lib.c93
-rw-r--r--lib.h9
-rw-r--r--txr.181
5 files changed, 201 insertions, 7 deletions
diff --git a/ChangeLog b/ChangeLog
index 77d4a80c..4ecc3fae 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,23 @@
+2014-06-16 Kaz Kylheku <kaz@kylheku.com>
+
+ * eval.c (eval_init): Register pos_max, pos_min, find_max,
+ find_min and seqp as intrinsics.
+
+ * lib.c (gt_f, lt_f): New variables.
+ (to_seq): renamed to toseq.
+ (seqp): New function.
+ (minmax): New static function.
+ (replace_str, replace_vec): Follow to_seq renaming.
+ (find_max, find_min, pos_max, pos_min): New functions.
+ (obj_init): gc-protect and initialize gt_f and lt_f.
+
+
+ * lib.h (gt_f, lt_f): Declared.
+ (to_seq): Declaration updated to toseq.
+ (seqp, find_max, find_min, pos_max, pos_min): Declared.
+
+ * txr.1: Updated.
+
2014-06-15 Kaz Kylheku <kaz@kylheku.com>
* eval.c (eval_init): where and sel registered as intrinsics
diff --git a/eval.c b/eval.c
index 50bf22e6..2720b76a 100644
--- a/eval.c
+++ b/eval.c
@@ -3328,6 +3328,8 @@ void eval_init(void)
reg_fun(intern(lit("/="), user_package), func_n0v(numneqv));
reg_fun(intern(lit("max"), user_package), func_n1v(maxv));
reg_fun(intern(lit("min"), user_package), func_n1v(minv));
+ reg_fun(intern(lit("pos-max"), user_package), func_n3o(pos_max, 1));
+ reg_fun(intern(lit("pos-min"), user_package), func_n3o(pos_min, 1));
reg_fun(intern(lit("logand"), user_package), func_n0v(logandv));
reg_fun(intern(lit("logior"), user_package), func_n0v(logiorv));
reg_fun(intern(lit("logxor"), user_package), func_n2(logxor));
@@ -3524,8 +3526,11 @@ void eval_init(void)
reg_fun(intern(lit("find"), user_package), func_n4o(find, 2));
reg_fun(intern(lit("multi-sort"), user_package), func_n3o(multi_sort, 2));
reg_fun(intern(lit("find-if"), user_package), func_n3o(find_if, 2));
+ reg_fun(intern(lit("find-max"), user_package), func_n3o(find_max, 1));
+ reg_fun(intern(lit("find-min"), user_package), func_n3o(find_min, 1));
reg_fun(intern(lit("set-diff"), user_package), func_n4o(set_diff, 2));
+ reg_fun(intern(lit("seqp"), user_package), func_n1(seqp));
reg_fun(intern(lit("length"), user_package), func_n1(length));
reg_fun(intern(lit("empty"), user_package), func_n1(empty));
reg_fun(intern(lit("copy"), user_package), func_n1(copy));
diff --git a/lib.c b/lib.c
index 788ad875..e2b42506 100644
--- a/lib.c
+++ b/lib.c
@@ -96,7 +96,7 @@ val null_string;
val nil_string;
val null_list;
-val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f, null_f;
+val identity_f, equal_f, eql_f, eq_f, gt_f, lt_f, car_f, cdr_f, null_f;
val prog_string;
@@ -488,7 +488,7 @@ val make_like(val list, val thatobj)
return list;
}
-val to_seq(val seq)
+val toseq(val seq)
{
switch (type(seq)) {
case VEC:
@@ -541,6 +541,22 @@ val nullify(val seq)
}
}
+val seqp(val obj)
+{
+ switch (type(obj)) {
+ case NIL:
+ case CONS:
+ case LCONS:
+ case VEC:
+ case STR:
+ case LSTR:
+ case LIT:
+ return t;
+ default:
+ return nil;
+ }
+}
+
loc list_collect(loc ptail, val obj)
{
switch (type(deref(ptail))) {
@@ -2220,7 +2236,7 @@ val sub_str(val str_in, val from, val to)
val replace_str(val str_in, val items, val from, val to)
{
- val itseq = to_seq(items);
+ val itseq = toseq(items);
val len = length_str(str_in);
val len_it = length(itseq);
val len_rep;
@@ -4184,7 +4200,7 @@ val sub_vec(val vec_in, val from, val to)
val replace_vec(val vec_in, val items, val from, val to)
{
- val it_seq = to_seq(items);
+ val it_seq = toseq(items);
val len = length_vec(vec_in);
val len_it = length(it_seq);
val len_rep;
@@ -4941,6 +4957,38 @@ val find(val item, val list, val testfun, val keyfun)
return nil;
}
+val find_max(val seq_in, val testfun, val keyfun)
+{
+ val seq = nullify(seq_in);
+ val maxkey;
+ val maxelt;
+
+ if (!seq)
+ return nil;
+
+ testfun = default_arg(testfun, gt_f);
+ keyfun = default_arg(keyfun, identity_f);
+
+ maxelt = car(seq_in);
+ maxkey = funcall1(keyfun, maxelt);
+
+ for (seq = cdr(seq); seq; seq = cdr(seq)) {
+ val elt = car(seq);
+ val key = funcall1(keyfun, elt);
+ if (funcall2(testfun, key, maxkey)) {
+ maxkey = key;
+ maxelt = elt;
+ }
+ }
+
+ return maxelt;
+}
+
+val find_min(val seq, val testfun, val keyfun)
+{
+ return find_max(seq, default_arg(testfun, lt_f), keyfun);
+}
+
val find_if(val pred, val list, val key)
{
key = default_arg(key, identity_f);
@@ -5032,6 +5080,38 @@ val pos_if(val pred, val list, val key)
return nil;
}
+val pos_max(val seq_in, val testfun, val keyfun)
+{
+ val pos = zero;
+ val seq = nullify(seq_in);
+ val maxkey;
+ val maxpos = zero;
+
+ if (!seq)
+ return nil;
+
+ testfun = default_arg(testfun, gt_f);
+ keyfun = default_arg(keyfun, identity_f);
+
+ maxkey = funcall1(keyfun, car(seq));
+
+ for (seq = cdr(seq); seq; seq = cdr(seq)) {
+ val key = funcall1(keyfun, car(seq));
+ pos = plus(pos, one);
+ if (funcall2(testfun, key, maxkey)) {
+ maxkey = key;
+ maxpos = pos;
+ }
+ }
+
+ return maxpos;
+}
+
+val pos_min(val seq, val testfun, val keyfun)
+{
+ return pos_max(seq, default_arg(testfun, lt_f), keyfun);
+}
+
val set_diff(val list1, val list2, val testfun, val keyfun)
{
list_collect_decl (out, ptail);
@@ -5409,7 +5489,8 @@ static void obj_init(void)
protect(&packages, &system_package_var, &keyword_package_var,
&user_package_var, &null_string, &nil_string,
- &null_list, &equal_f, &eq_f, &eql_f, &car_f, &cdr_f, &null_f,
+ &null_list, &equal_f, &eq_f, &eql_f, &gt_f, &lt_f,
+ &car_f, &cdr_f, &null_f,
&identity_f, &prog_string, &env_list,
(val *) 0);
@@ -5535,6 +5616,8 @@ static void obj_init(void)
equal_f = func_n2(equal);
eq_f = func_n2(eq);
eql_f = func_n2(eql);
+ gt_f = func_n2(gt);
+ lt_f = func_n2(lt);
identity_f = func_n1(identity);
car_f = func_n1(car);
cdr_f = func_n1(cdr);
diff --git a/lib.h b/lib.h
index 31ca1413..548a0696 100644
--- a/lib.h
+++ b/lib.h
@@ -377,7 +377,7 @@ extern val nothrow_k, args_k, colon_k, auto_k;
extern val null_string;
extern val null_list; /* (nil) */
-extern val identity_f, equal_f, eql_f, eq_f, car_f, cdr_f, null_f;
+extern val identity_f, equal_f, eql_f, eq_f, gt_f, lt_f, car_f, cdr_f, null_f;
extern const wchar_t *progname;
@@ -426,9 +426,10 @@ val upop(val *plist, val *pundo);
val push(val v, val *plist);
val copy_list(val list);
val make_like(val list, val thatobj);
-val to_seq(val obj);
+val toseq(val obj);
val tolist(val seq);
val nullify(val seq);
+val seqp(val obj);
val nreverse(val in);
val reverse(val in);
val append2(val list1, val list2);
@@ -736,11 +737,15 @@ val sort(val seq, val lessfun, val keyfun);
val multi_sort(val lists, val funcs, val key_funcs);
val find(val list, val key, val testfun, val keyfun);
val find_if(val pred, val list, val key);
+val find_max(val seq, val testfun, val keyfun);
+val find_min(val seq, val testfun, val keyfun);
val posqual(val obj, val list);
val posql(val obj, val list);
val posq(val obj, val list);
val pos(val list, val key, val testfun, val keyfun);
val pos_if(val pred, val list, val key);
+val pos_max(val seq, val testfun, val keyfun);
+val pos_min(val seq, val testfun, val keyfun);
val set_diff(val list1, val list2, val testfun, val keyfun);
val copy(val seq);
val length(val seq);
diff --git a/txr.1 b/txr.1
index 5bd5e15a..d52c2a84 100644
--- a/txr.1
+++ b/txr.1
@@ -7736,6 +7736,40 @@ by applying the key function to successive elements. The position of
the first element for which the predicate function yields true is returned. If
no such element is found, nil is returned.
+.SS Functions pos-max and pos-min
+
+.TP
+Syntax:
+
+ (pos-max <sequence> [<testfun> [<keyfun>]])
+ (pos-min <sequence> [<testfun> [<keyfun>]])
+
+.TP
+Description:
+
+The pos-min and pos-max function implement exactly the same algorithm; they
+differ only in their defaulting behavior with regard to the <testfun>
+argument. If <tesfunc> is not given, then the pos-max function defaults it to
+the > function, whereas pos-min defaults it to the < function.
+
+If <sequence> is empty, both functions return nil.
+
+Without a <testfun> argument, the pos-max function finds the zero-based
+position index of the numerically maximum value occurring in <sequence>,
+whereas pos-min without a <testfun> argument finds the index of the minimum
+value.
+
+If a <testfun> argument is given, the two functions are equivalent.
+The <testfun> function must be callable with two arguments.
+If <testfun> behaves like a greater-than comparison, then pos-max
+and pos-min return the index of the maximum element. If <testfun>
+behaves like a less-than comparison, then the functions return
+the index of the minimum element.
+
+The <keyfun> argument defaults to the identity function. Each element
+from sequence is passed through this one-argument function, and
+the resulting value is used in its place.
+
.SS Function where
.TP
@@ -7833,6 +7867,38 @@ by applying the key function to successive elements. The first element
for which the predicate function yields true is returned. If no such
element is found, nil is returned.
+.SS Functions find-max and find-min
+
+.TP
+Syntax:
+
+ (find-max <sequence> [<testfun> [<keyfun>]])
+ (find-min <sequence> [<testfun> [<keyfun>]])
+
+.TP
+Description:
+
+The find-min and find-max function implement exactly the same algorithm; they
+differ only in their defaulting behavior with regard to the <testfun>
+argument. If <tesfunc> is not given, then the find-max function defaults it to
+the > function, whereas find-min defaults it to the < function.
+
+Without a <testfun> argument, the find-max function finds the numerically
+maximum value occurring in <sequence>, whereas pos-min without a <testfun>
+argument finds the minimum value.
+
+If a <testfun> argument is given, the two functions are equivalent.
+The <testfun> function must be callable with two arguments.
+If <testfun> behaves like a greater-than comparison, then find-max
+and find-min both return the maximum element. If <testfun>
+behaves like a less-than comparison, then the functions return
+the minimum element.
+
+The <keyfun> argument defaults to the identity function. Each element
+from sequence is passed through this one-argument function, and
+the resulting value is used in its place for the purposes of the
+comparison. However, the original element is returned.
+
.SS Function set-diff
.TP
@@ -9931,6 +9997,21 @@ order.
.SH SEQUENCE MANIPULATION
+.SS Function seqp
+
+.TP
+Syntax:
+
+ (seqp <object>)
+
+.TP
+Description:
+
+The function seqp returns t if <object> is a sequence, otherwise nil.
+
+A sequence is defined as a list, vector or string. The object nil denotes
+the empty list and so is a sequence.
+
.SS Function length
.TP