diff options
| author | Kaz Kylheku <kaz@kylheku.com> | 2014-07-14 07:07:48 -0700 |
|---|---|---|
| committer | Kaz Kylheku <kaz@kylheku.com> | 2014-07-14 07:07:48 -0700 |
| commit | facdfbaf35edae7afb51f6c3dc4d5baa119ea605 (patch) | |
| tree | 981db066ebc1b269499b11beb80aa9f618a18e75 | |
| parent | f9c30536415bf20df76d60dffa7b851c2825e787 (diff) | |
| download | txr-facdfbaf35edae7afb51f6c3dc4d5baa119ea605.tar.gz txr-facdfbaf35edae7afb51f6c3dc4d5baa119ea605.tar.bz2 txr-facdfbaf35edae7afb51f6c3dc4d5baa119ea605.zip | |
* 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.
| -rw-r--r-- | ChangeLog | 11 | ||||
| -rw-r--r-- | eval.c | 2 | ||||
| -rw-r--r-- | lib.c | 61 | ||||
| -rw-r--r-- | lib.h | 2 | ||||
| -rw-r--r-- | txr.1 | 51 |
5 files changed, 127 insertions, 0 deletions
@@ -1,3 +1,14 @@ +2014-07-14 Kaz Kylheku <kaz@kylheku.com> + + * 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 <kaz@kylheku.com> Version 92. @@ -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)); @@ -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); @@ -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); @@ -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 <sep> <sequence>) + +.TP +Description: + +The interpose function returns a sequence of the same type as <sequence>, +in which the elements from <sequence> appear with the <sep> value inserted +between them. + +If <sequence> is an empty sequence or a sequence of length 1, then a +sequence identical to <sequence> is returned. It may be a copy of <sequence> +or it may be <sequence> itself. + +If <sequence> is a character string, then the value <sep> must be a character. + +It is permissible for <sequence>, or for a suffix of <sequence> 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 <value>) + +.TP +Description: + +The lconsp function returns t if <value> is a lazy cons cell. Otherwise +it returns nil, even if <value> is an ordinary cons cell. + .SS Function lcons-fun .TP |