diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2021-06-21 06:37:50 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2021-06-21 06:37:50 -0700 |
commit | ff2df257b64111213fd94028d2f18b75ebdee003 (patch) | |
tree | 45cf0a063bfc829c6e619fb8482a215f4884f2ed | |
parent | 4605d81ba9ef004e1a0e660ccd5d42717c4c6523 (diff) | |
download | txr-ff2df257b64111213fd94028d2f18b75ebdee003.tar.gz txr-ff2df257b64111213fd94028d2f18b75ebdee003.tar.bz2 txr-ff2df257b64111213fd94028d2f18b75ebdee003.zip |
Dubious new functions cxr/cyr.
* lib.c (cxr, cyr): New functions.
* lib.h (cxr, cyr): Declared.
* eval.c (eval_init): Intrinsics cxr and cyr registered.
* tests/012/cadr.tl: New file.
* txr.1: Documented.
* share/txr/stdlib/doc-syms.tl: Updated.
-rw-r--r-- | eval.c | 2 | ||||
-rw-r--r-- | lib.c | 69 | ||||
-rw-r--r-- | lib.h | 2 | ||||
-rw-r--r-- | share/txr/stdlib/doc-syms.tl | 2 | ||||
-rw-r--r-- | tests/012/cadr.tl | 14 | ||||
-rw-r--r-- | txr.1 | 52 |
6 files changed, 141 insertions, 0 deletions
@@ -6740,6 +6740,8 @@ void eval_init(void) reg_fun(intern(lit("eighth"), user_package), func_n1(eighth)); reg_fun(intern(lit("ninth"), user_package), func_n1(ninth)); reg_fun(intern(lit("tenth"), user_package), func_n1(tenth)); + reg_fun(intern(lit("cxr"), user_package), func_n2(cxr)); + reg_fun(intern(lit("cyr"), user_package), func_n2(cyr)); reg_fun(intern(lit("conses"), user_package), func_n1(conses)); reg_fun(intern(lit("conses*"), user_package), func_n1(lazy_conses)); reg_fun(intern(lit("copy-list"), user_package), func_n1(copy_list)); @@ -1468,6 +1468,75 @@ val tenth(val obj) return ref(obj, num_fast(9)); } +val cxr(val addr, val obj) +{ + val self = lit("cxr"); + + switch (type(addr)) { + case NUM: + { + cnum a = c_num(addr, self); + if (a > 0) { + for (; a != 1; a >>= 1) + obj = if3((a & 1) != 0, car(obj), cdr(obj)); + return obj; + } + } + break; + case BGNUM: + { + mp_int *a = mp(addr); + if (!mp_isneg(a)) { + mp_size i, n = mp_count_bits(a); + for (i = 0; i < n - 1; i++) + obj = if3(mp_bit(a, i) == MP_YES, car(obj), cdr(obj)); + return obj; + } + } + break; + default: + break; + } + + uw_throwf(error_s, lit("~a: ~s is an invalid address"), self, addr, nao); +} + +val cyr(val addr, val obj) +{ + val self = lit("cyr"); + + switch (type(addr)) { + case NUM: + { + cnum a = c_num(addr, self); + if (a > 0) { + int m, h = highest_bit(a); + if (h > 1) { + for (m = 1 << (h - 2); m != 0; m >>= 1) + obj = if3((a & m) != 0, car(obj), cdr(obj)); + } + return obj; + } + } + break; + case BGNUM: + { + mp_int *a = mp(addr); + if (!mp_isneg(a)) { + mp_size i, n = mp_count_bits(a); + for (i = n - 2; i != (mp_size) -1; i--) + obj = if3(mp_bit(a, i) == MP_YES, car(obj), cdr(obj)); + return obj; + } + } + break; + default: + break; + } + + uw_throwf(error_s, lit("~a: ~s is an invalid address"), self, addr, nao); +} + val conses(val list) { list_collect_decl (out, ptail); @@ -603,6 +603,8 @@ val seventh(val cons); val eighth(val cons); val ninth(val cons); val tenth(val cons); +val cxr(val addr, val obj); +val cyr(val addr, val obj); val conses(val list); val lazy_conses(val list); val listref(val list, val ind); diff --git a/share/txr/stdlib/doc-syms.tl b/share/txr/stdlib/doc-syms.tl index 4a860470..36e1e197 100644 --- a/share/txr/stdlib/doc-syms.tl +++ b/share/txr/stdlib/doc-syms.tl @@ -443,6 +443,8 @@ ("csize" "N-01B1B5DF") ("cstopb" "N-01B1B5DF") ("cum-norm-dist" "N-03AB449B") + ("cxr" "N-01DA4F04") + ("cyr" "N-01DA4F04") ("daemon" "N-017C3515") ("data" "N-03B6EA7D") ("dec" "N-03A0AABD") diff --git a/tests/012/cadr.tl b/tests/012/cadr.tl new file mode 100644 index 00000000..509590f7 --- /dev/null +++ b/tests/012/cadr.tl @@ -0,0 +1,14 @@ +(load "../common") + +(mtest + (cxr 1 42) 42 + (cxr #b11 '(a . b)) a + (cxr #b10 '(a . b)) b + (cxr #b11000 '(1 2 3 4 5)) 4 + (cyr #b100001 '(1 2 3 4 5)) 5 + (cyr #b1111 '(((a)))) a + (cyr #b111 '(a)) :error) + +(let ((r (range* 0 100))) + (vtest (mapcar (op cyr (succ (expt 2 (succ @1))) r) 0..100) r) + (vtest (mapcar (op cxr (* 3 (expt 2 @1)) r) 0..100) r)) @@ -21598,6 +21598,58 @@ places. For example, means the same as .codn "(del (car (cddr x)))" . +.coNP Functions @ cyr and @ cxr +.synb +.mets (cyr < address << object ) +.mets (cxr < address << object ) +.syne +.desc +The +.code cyr +and +.code cxr +functions provide +.cod3 car / cdr +navigation of tree structure driven by numeric address given by the +.meta address +argument. + +The +.meta address +argument can express any combination of the application of +.code car +and +.code cdr +functions, including none at all. + +The difference between +.code cyr +and +.code cxr +is the bit order of the encoding. Under +.codn cyr , +the most significant bit of the encoding given in +.meta address +indicates the initial +.cod3 car / cdr +navigation, and the least significant bit gives the final one. +Under +.codn cxr , +it is opposite. + +Both functions require +.meta address +to be a positive integer. Any other argument raises an error. + +Under both functions, the +.meta address +value +.code 1 +encodes the +.code identity +operation: no +.cod3 car / cdr + .coNP Functions @ flatten and @ flatten* .synb .mets (flatten << list ) |