From facdfbaf35edae7afb51f6c3dc4d5baa119ea605 Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Mon, 14 Jul 2014 07:07:48 -0700 Subject: * eval.c (eval_init): Register interpose and lconsp as intrinsics. * lib.c (lconsp, interpose): New functions. (lazy_interpose_func, lazy_interpose): New static functions. * lib.h (lconsp, interpose): Declared. * txr.1: Documented lconsp and interpose. --- ChangeLog | 11 +++++++++++ eval.c | 2 ++ lib.c | 61 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ lib.h | 2 ++ txr.1 | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 127 insertions(+) diff --git a/ChangeLog b/ChangeLog index 9fd48755..a4ee33d3 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,14 @@ +2014-07-14 Kaz Kylheku + + * eval.c (eval_init): Register interpose and lconsp as intrinsics. + + * lib.c (lconsp, interpose): New functions. + (lazy_interpose_func, lazy_interpose): New static functions. + + * lib.h (lconsp, interpose): Declared. + + * txr.1: Documented lconsp and interpose. + 2014-07-10 Kaz Kylheku Version 92. diff --git a/eval.c b/eval.c index 05b1d93d..e8c1c7da 100644 --- a/eval.c +++ b/eval.c @@ -3497,6 +3497,7 @@ void eval_init(void) reg_fun(intern(lit("true"), user_package), func_n1(not_null)); reg_fun(not_s, null_f); reg_fun(intern(lit("consp"), user_package), func_n1(consp)); + reg_fun(intern(lit("lconsp"), user_package), func_n1(lconsp)); reg_fun(intern(lit("listp"), user_package), func_n1(listp)); reg_fun(intern(lit("proper-listp"), user_package), func_n1(proper_listp)); reg_fun(intern(lit("length-list"), user_package), func_n1(length_list)); @@ -3512,6 +3513,7 @@ void eval_init(void) reg_fun(intern(lit("reduce-right"), user_package), func_n4o(reduce_right, 2)); reg_fun(intern(lit("transpose"), user_package), func_n1(transpose)); reg_fun(intern(lit("zip"), user_package), func_n0v(transpose)); + reg_fun(intern(lit("interpose"), user_package), func_n2(interpose)); reg_fun(intern(lit("second"), user_package), func_n1(second)); reg_fun(intern(lit("third"), user_package), func_n1(third)); diff --git a/lib.c b/lib.c index d6f4f080..9289250a 100644 --- a/lib.c +++ b/lib.c @@ -1612,6 +1612,11 @@ val consp(val obj) return (ty == CONS || ty == LCONS) ? t : nil; } +val lconsp(val obj) +{ + return type(obj) == LCONS ? t : nil; +} + val atom(val obj) { return if3(consp(obj), nil, t); @@ -4974,6 +4979,62 @@ val mappend(val fun, val list) return make_like(out, list_orig); } +static val lazy_interpose_func(val env, val lcons) +{ + cons_bind (sep, list, env); + val next = cdr(list); + val fun = lcons_fun(lcons); + + rplaca(lcons, car(list)); + + if (next) { + rplacd(env, next); + func_set_env(fun, env); + rplacd(lcons, cons(sep, make_lazy_cons(fun))); + } + + return nil; +} + +static val lazy_interpose(val sep, val list) +{ + return make_lazy_cons(func_f1(cons(sep, list), + lazy_interpose_func)); +} + +val interpose(val sep, val seq) +{ + switch (type(seq)) { + case NIL: + return nil; + case CONS: + { + val next; + list_collect_decl (out, ptail); + for (next = cdr(seq); next; seq = next, next = cdr(seq)) { + ptail = list_collect(ptail, car(seq)); + ptail = list_collect(ptail, sep); + if (lconsp(next)) { + list_collect_nconc(ptail, lazy_interpose(sep, next)); + return out; + } + } + list_collect(ptail, car(seq)); + return out; + } + case LCONS: + return lazy_interpose(sep, seq); + case LIT: + case STR: + case LSTR: + return cat_str(interpose(sep, tolist(seq)), nil); + case VEC: + return vector_list(interpose(sep, tolist(seq))); + default: + type_mismatch(lit("interpose: ~s is not a sequence"), seq, nao); + } +} + val merge(val list1, val list2, val lessfun, val keyfun) { list_collect_decl (out, ptail); diff --git a/lib.h b/lib.h index a20382da..81fea9b8 100644 --- a/lib.h +++ b/lib.h @@ -480,6 +480,7 @@ val make_half_lazy_cons(val func, val car); val lcons_fun(val lcons); val list(val first, ...); /* terminated by nao */ val consp(val obj); +val lconsp(val obj); val atom(val obj); val listp(val obj); val proper_listp(val obj); @@ -741,6 +742,7 @@ val mapcar_listout(val fun, val list); val mapcar(val fun, val list); val mapcon(val fun, val list); val mappend(val fun, val list); +val interpose(val sep, val seq); val merge(val list1, val list2, val lessfun, val keyfun); val sort(val seq, val lessfun, val keyfun); val multi_sort(val lists, val funcs, val key_funcs); diff --git a/txr.1 b/txr.1 index efad5ab9..20b977ab 100644 --- a/txr.1 +++ b/txr.1 @@ -7160,6 +7160,9 @@ case, nil otherwise. Non-empty lists test positive under consp because a list is represented as a reference to the first cons in a chain of one or more conses. +Note that a lazy cons is a cons and satisfies the consp test. See the function +make-lazy-cons. + .TP Examples: @@ -8172,6 +8175,41 @@ Examples: (zip '(a b c) '(c d e)) -> ((a c) (b d) (c e)) +.SS Function interpose + +.TP +Syntax: + + (interpose ) + +.TP +Description: + +The interpose function returns a sequence of the same type as , +in which the elements from appear with the value inserted +between them. + +If is an empty sequence or a sequence of length 1, then a +sequence identical to is returned. It may be a copy of +or it may be itself. + +If is a character string, then the value must be a character. + +It is permissible for , or for a suffix of to be a lazy +list, in which case interpose returns a lazy list, or a list with a lazy +suffix. + +.SS +Examples: + + (interpose #\e- "xyz") -> "x-y-z" + (interpose t nil) -> nil + (interpose t #()) -> #() + (interpose #\ea "") -> "" + (interpose t (range 0 0)) -> (0) + (interpose t (range 0 1)) -> (0 t 1) + (interpose t (range 0 2)) -> (0 t 1 t 2) + .SS Functions conses and conses* .TP @@ -8736,6 +8774,19 @@ Example: (rplacd lcons (make-lazy-cons (lcons-fun lcons)))))))))) +.SS Function lconsp + +.TP +Syntax: + + (lconsp ) + +.TP +Description: + +The lconsp function returns t if is a lazy cons cell. Otherwise +it returns nil, even if is an ordinary cons cell. + .SS Function lcons-fun .TP -- cgit v1.2.3