commit 6fdc0dabcbb73819675aca0aa530dfd9f03382a5
parent 70ee93008be662eac3194822241d60e9bebd4c18
Author: Andres Navarro <canavarro82@gmail.com>
Date: Mon, 28 Nov 2011 18:32:53 -0300
Added string-map, vector-map, and bytevector-map to the ground environment. Added the corresponding tests. Refactored the conversion routines from and to list from all array types.
Diffstat:
9 files changed, 415 insertions(+), 129 deletions(-)
diff --git a/TODO b/TODO
@@ -15,6 +15,9 @@
** eliminate char * arguments where not needed (like list check/copy
functions in kghelpers
** check if all inline functions need to be inline
+** standarize either int32_t (now used in lists) or uint32_t (now used
+ in strings, vectors and bytevectors) for sizes (and maybe use a
+ typedef like lua)
* fix:
** fix/test the tty detection in the interpreter
** current-jiffy (r7rs)
diff --git a/src/kgbytevectors.c b/src/kgbytevectors.c
@@ -28,30 +28,6 @@
/* ?.? immutable-bytevector?, mutable-bytevector? */
/* use ftypep */
-/* Helper for bytevector and list->bytevector */
-/* GC: Assumes ls is rooted */
-TValue list_to_bytevector_h(klisp_State *K, char *name, TValue ls)
-{
- /* don't allow cycles */
- int32_t pairs;
- check_typed_list(K, ku8p, false, ls, &pairs, NULL);
-
- TValue new_bb;
- /* the if isn't strictly necessary but it's clearer this way */
- if (pairs == 0) {
- return K->empty_bytevector;
- } else {
- new_bb = kbytevector_new_s(K, pairs);
- uint8_t *buf = kbytevector_buf(new_bb);
- TValue tail = ls;
- while(pairs--) {
- *buf++ = ivalue(kcar(tail));
- tail = kcdr(tail);
- }
- return new_bb;
- }
-}
-
/* ?.? bytevector */
void bytevector(klisp_State *K)
{
@@ -62,7 +38,10 @@ void bytevector(klisp_State *K)
UNUSED(xparams);
UNUSED(denv);
- TValue new_bb = list_to_bytevector_h(K, "bytevector", ptree);
+ /* don't allow cycles */
+ int32_t pairs;
+ check_typed_list(K, ku8p, false, ptree, &pairs, NULL);
+ TValue new_bb = list_to_bytevector_h(K, ptree, pairs);
kapply_cc(K, new_bb);
}
@@ -77,18 +56,9 @@ void bytevector_to_list(klisp_State *K)
UNUSED(denv);
bind_1tp(K, ptree, "bytevector", ttisbytevector, bb);
- int32_t pairs = kbytevector_size(bb);
- uint8_t *buf = kbytevector_buf(bb);
- TValue tail = kget_dummy1(K);
-
- while(pairs--) {
- TValue new_pair = kcons(K, i2tv(*buf), KNIL);
- buf++;
- kset_cdr(tail, new_pair);
- tail = new_pair;
- }
- kapply_cc(K, kcutoff_dummy1(K));
+ TValue res = bytevector_to_list_h(K, bb, NULL);
+ kapply_cc(K, res);
}
/* ?.? list->bytevector */
@@ -104,7 +74,10 @@ void list_to_bytevector(klisp_State *K)
/* check later in list_to_bytevector_h */
bind_1p(K, ptree, ls);
- TValue new_bb = list_to_bytevector_h(K, "list->bytevector", ls);
+ /* don't allow cycles */
+ int32_t pairs;
+ check_typed_list(K, ku8p, false, ls, &pairs, NULL);
+ TValue new_bb = list_to_bytevector_h(K, ls, pairs);
kapply_cc(K, new_bb);
}
diff --git a/src/kgcombiners.c b/src/kgcombiners.c
@@ -25,11 +25,14 @@
/* continuations */
void do_vau(klisp_State *K);
+
+void do_map(klisp_State *K);
void do_map_ret(klisp_State *K);
void do_map_encycle(klisp_State *K);
-void do_map(klisp_State *K);
void do_map_cycle(klisp_State *K);
+void do_array_map_ret(klisp_State *K);
+
/* 4.10.1 operative? */
/* uses typep */
@@ -449,6 +452,36 @@ void map(klisp_State *K)
** an open issue (see comment in map).
*/
+/* NOTE: the type error on the result of app are only checked after
+ all values are collected. This could be changed if necessary, by
+ having map continuations take an additional typecheck param */
+/* Helpers for array_map */
+
+/* copy the resulting list to a new vector */
+void do_array_map_ret(klisp_State *K)
+{
+ TValue *xparams = K->next_xparams;
+ TValue obj = K->next_value;
+ klisp_assert(ttisnil(K->next_env));
+ /*
+ ** xparams[0]: (dummy . complete-ls)
+ ** xparams[1]: list->array
+ ** xparams[2]: length
+ */
+ UNUSED(obj);
+
+ TValue ls = kcdr(xparams[0]);
+ TValue (*list_to_array)(klisp_State *K, TValue array, int32_t size) =
+ pvalue(xparams[1]);
+ int32_t length = ivalue(xparams[2]);
+
+ /* This will also avoid some problems with continuations
+ captured from within the dynamic extent to map
+ and later mutation of the result */
+ TValue copy = list_to_array(K, ls, length);
+ kapply_cc(K, copy);
+}
+
/* 5.9.? string-map */
/* 5.9.? vector-map */
/* 5.9.? bytevector-map */
@@ -460,51 +493,71 @@ void array_map(klisp_State *K)
klisp_assert(ttisenvironment(K->next_env));
/*
- ** xparams[0]: array->list fn
- ** xparams[1]: list->array fn
- ** xparams[2]: type name
+ ** xparams[0]: list->array fn
+ ** xparams[1]: array->list fn (with type check and size ret)
*/
- UNUSED(xparams);
+ TValue list_to_array_tv = xparams[0];
+ TValue (*array_to_list)(klisp_State *K, TValue array, int32_t *size) =
+ pvalue(xparams[1]);
-/* TODO */
bind_al1tp(K, ptree, "applicative", ttisapplicative, app, lss);
+ /* check that lss is a non empty list, and copy it */
if (ttisnil(lss)) {
- klispE_throw_simple(K, "no lists");
+ klispE_throw_simple(K, "no arguments after applicative");
return;
}
- /* get the metrics of the ptree of each call to app and
- of the result list */
int32_t app_pairs, app_apairs, app_cpairs;
- int32_t res_pairs, res_apairs, res_cpairs;
-
- map_for_each_get_metrics(K, lss, &app_apairs, &app_cpairs,
- &res_apairs, &res_cpairs);
- app_pairs = app_apairs + app_cpairs;
- res_pairs = res_apairs + res_cpairs;
+ /* the copied list should be protected from gc, and will host
+ the lists resulting from the conversion */
+ lss = check_copy_list(K, lss, true, &app_pairs, &app_cpairs);
+ app_apairs = app_pairs - app_cpairs;
+ krooted_tvs_push(K, lss);
+ /* check that all elements have the correct type and same size,
+ and convert them to lists */
+ int32_t res_pairs;
+ TValue head = kcar(lss);
+ TValue tail = kcdr(lss);
+ TValue ls = array_to_list(K, head, &res_pairs);
+ kset_car(lss, ls); /* save the first */
+ /* all array will produce acyclic lists */
+
+ for(int32_t i = 1 /* jump over first */; i < app_pairs; ++i) {
+ head = kcar(tail);
+ int32_t pairs;
+ ls = array_to_list(K, head, &pairs);
+ /* in klisp all arrays should have the same length */
+ if (pairs != res_pairs) {
+ klispE_throw_simple(K, "arguments of different length");
+ return;
+ }
+ kset_car(tail, ls);
+ tail = kcdr(tail);
+ }
+
/* create the list of parameters to app */
lss = map_for_each_transpose(K, lss, app_apairs, app_cpairs,
- res_apairs, res_cpairs);
+ res_pairs, 0); /* cycle pairs is always 0 */
/* ASK John: the semantics when this is mixed with continuations,
isn't all that great..., but what are the expectations considering
there is no prescribed order? */
+ krooted_tvs_pop(K);
krooted_tvs_push(K, lss);
- /* This will be the list to be returned, but it will be copied
- before to play a little nicer with continuations */
+ /* This will be the list to be returned, but it will be transformed
+ to an array before returning (making it also play a little nicer
+ with continuations) */
TValue dummy = kcons(K, KINERT, KNIL);
krooted_tvs_push(K, dummy);
- TValue ret_cont = (res_cpairs == 0)?
- kmake_continuation(K, kget_cc(K), do_map_ret, 1, dummy)
- : kmake_continuation(K, kget_cc(K), do_map_cycle, 4,
- app, dummy, i2tv(res_cpairs), denv);
-
+ TValue ret_cont =
+ kmake_continuation(K, kget_cc(K), do_array_map_ret, 3, dummy,
+ list_to_array_tv, i2tv(res_pairs));
krooted_tvs_push(K, ret_cont);
/* schedule the mapping of the elements of the acyclic part.
@@ -512,7 +565,7 @@ void array_map(klisp_State *K)
the inert value passed to the first continuation */
TValue new_cont =
kmake_continuation(K, ret_cont, do_map, 6, app, lss, dummy,
- i2tv(res_apairs), denv, KTRUE);
+ i2tv(res_pairs), denv, KTRUE);
krooted_tvs_pop(K);
krooted_tvs_pop(K);
@@ -552,6 +605,13 @@ void kinit_combiners_ground_env(klisp_State *K)
add_applicative(K, ground_env, "apply", apply, 0);
/* 5.9.1 map */
add_applicative(K, ground_env, "map", map, 0);
+ /* 5.9.? string-map, vector-map, bytevector-map */
+ add_applicative(K, ground_env, "string-map", array_map, 2,
+ p2tv(list_to_string_h), p2tv(string_to_list_h));
+ add_applicative(K, ground_env, "vector-map", array_map, 2,
+ p2tv(list_to_vector_h), p2tv(vector_to_list_h));
+ add_applicative(K, ground_env, "bytevector-map", array_map, 2,
+ p2tv(list_to_bytevector_h), p2tv(bytevector_to_list_h));
/* 6.2.1 combiner? */
add_applicative(K, ground_env, "combiner?", ftypep, 2, symbol,
p2tv(kcombinerp));
@@ -562,9 +622,12 @@ void kinit_combiners_cont_names(klisp_State *K)
{
Table *t = tv2table(K->cont_name_table);
+ add_cont_name(K, t, do_vau, "$vau-bind!-eval");
+
add_cont_name(K, t, do_map, "map-acyclic-part");
add_cont_name(K, t, do_map_encycle, "map-encycle!");
add_cont_name(K, t, do_map_ret, "map-ret");
add_cont_name(K, t, do_map_cycle, "map-cyclic-part");
- add_cont_name(K, t, do_vau, "$vau-bind!-eval");
+
+ add_cont_name(K, t, do_array_map_ret, "array-map-ret");
}
diff --git a/src/kghelpers.c b/src/kghelpers.c
@@ -534,6 +534,146 @@ TValue check_copy_env_list(klisp_State *K, TValue obj)
return kcutoff_dummy3(K);
}
+/* Helpers for string, list->string, and string-map,
+ bytevector, list->bytevector, bytevector-map,
+ vector, list->vector, and vector-map */
+/* GC: Assume ls is rooted */
+/* ls should a list of length 'length' of the correct type
+ (chars for string, u8 for bytevector, any for vector) */
+/* these type checks each element */
+
+TValue list_to_string_h(klisp_State *K, TValue ls, int32_t length)
+{
+ TValue new_str;
+ /* the if isn't strictly necessary but it's clearer this way */
+ if (length == 0) {
+ return K->empty_string;
+ } else {
+ new_str = kstring_new_s(K, length);
+ char *buf = kstring_buf(new_str);
+ while(length-- > 0) {
+ TValue head = kcar(ls);
+ if (!ttischar(head)) {
+ klispE_throw_simple_with_irritants(K, "Bad type (expected "
+ "char)", 1, head);
+ return KINERT;
+ }
+ *buf++ = chvalue(head);
+ ls = kcdr(ls);
+ }
+ return new_str;
+ }
+}
+
+TValue list_to_vector_h(klisp_State *K, TValue ls, int32_t length)
+{
+
+ if (length == 0) {
+ return K->empty_vector;
+ } else {
+ TValue new_vec = kvector_new_sf(K, length, KINERT);
+ TValue *buf = kvector_buf(new_vec);
+ while(length-- > 0) {
+ *buf++ = kcar(ls);
+ ls = kcdr(ls);
+ }
+ return new_vec;
+ }
+}
+
+TValue list_to_bytevector_h(klisp_State *K, TValue ls, int32_t length)
+{
+ TValue new_bb;
+ /* the if isn't strictly necessary but it's clearer this way */
+ if (length == 0) {
+ return K->empty_bytevector;
+ } else {
+ new_bb = kbytevector_new_s(K, length);
+ uint8_t *buf = kbytevector_buf(new_bb);
+ while(length-- > 0) {
+ TValue head = kcar(ls);
+ if (!ttisu8(head)) {
+ klispE_throw_simple_with_irritants(K, "Bad type (expected "
+ "u8)", 1, head);
+ return KINERT;
+ }
+ *buf++ = ivalue(head);
+ ls = kcdr(ls);
+ }
+ return new_bb;
+ }
+}
+
+/* Helpers for string->list, string-map, string-foreach,
+ bytevector->list, bytevector-map, bytevector-foreach,
+ vector->list, vector-map, and vector-foreach */
+/* GC: Assume array is rooted */
+TValue string_to_list_h(klisp_State *K, TValue obj, int32_t *length)
+{
+ if (!ttisstring(obj)) {
+ klispE_throw_simple_with_irritants(K, "Bad type (expected string)",
+ 1, obj);
+ return KINERT;
+ }
+
+ int32_t pairs = kstring_size(obj);
+ if (length != NULL) *length = pairs;
+
+ char *buf = kstring_buf(obj) + pairs - 1;
+ TValue tail = KNIL;
+ krooted_vars_push(K, &tail);
+ while(pairs-- > 0) {
+ tail = kcons(K, ch2tv(*buf), tail);
+ --buf;
+ }
+ krooted_vars_pop(K);
+ return tail;
+}
+
+TValue vector_to_list_h(klisp_State *K, TValue obj, int32_t *length)
+{
+ if (!ttisvector(obj)) {
+ klispE_throw_simple_with_irritants(K, "Bad type (expected vector)",
+ 1, obj);
+ return KINERT;
+ }
+
+ int32_t pairs = kvector_size(obj);
+ if (length != NULL) *length = pairs;
+
+ TValue *buf = kvector_buf(obj) + pairs - 1;
+ TValue tail = KNIL;
+ krooted_vars_push(K, &tail);
+ while(pairs-- > 0) {
+ tail = kcons(K, *buf, tail);
+ --buf;
+ }
+ krooted_vars_pop(K);
+ return tail;
+}
+
+TValue bytevector_to_list_h(klisp_State *K, TValue obj, int32_t *length)
+{
+ if (!ttisbytevector(obj)) {
+ klispE_throw_simple_with_irritants(K, "Bad type (expected bytevector)",
+ 1, obj);
+ return KINERT;
+ }
+
+ int32_t pairs = kbytevector_size(obj);
+ if (length != NULL) *length = pairs;
+
+ uint8_t *buf = kbytevector_buf(obj) + pairs - 1;
+ TValue tail = KNIL;
+ krooted_vars_push(K, &tail);
+ while(pairs-- > 0) {
+ tail = kcons(K, i2tv(*buf), tail);
+ --buf;
+ }
+ krooted_vars_pop(K);
+ return tail;
+}
+
/* Some helpers for working with fixints (signed 32 bits) */
int64_t kgcd32_64(int32_t a_, int32_t b_)
{
diff --git a/src/kghelpers.h b/src/kghelpers.h
@@ -360,6 +360,19 @@ TValue check_copy_list(klisp_State *K, TValue obj, bool force_copy,
/* GC: assume obj is rooted, uses dummy3 */
TValue check_copy_env_list(klisp_State *K, TValue obj);
+/* The assimetry in error checking in the following functions
+ is a product of the contexts in which they are used, see the
+ .c for an enumeration of such contexts */
+/* list->? conversion functions, only type errors of elems checked */
+TValue list_to_string_h(klisp_State *K, TValue ls, int32_t length);
+TValue list_to_vector_h(klisp_State *K, TValue ls, int32_t length);
+TValue list_to_bytevector_h(klisp_State *K, TValue ls, int32_t length);
+
+/* ?->list conversion functions, type checked */
+TValue string_to_list_h(klisp_State *K, TValue obj, int32_t *length);
+TValue vector_to_list_h(klisp_State *K, TValue obj, int32_t *length);
+TValue bytevector_to_list_h(klisp_State *K, TValue obj, int32_t *length);
+
/*
** Generic function for type predicates
** It can only be used by types that have a unique tag
diff --git a/src/kgstrings.c b/src/kgstrings.c
@@ -138,30 +138,6 @@ void string_setB(klisp_State *K)
kapply_cc(K, KINERT);
}
-/* Helper for string and list->string */
-/* GC: Assumes ls is rooted */
-TValue list_to_string_h(klisp_State *K, char *name, TValue ls)
-{
- /* don't allow cycles */
- int32_t pairs;
- check_typed_list(K, kcharp, false, ls, &pairs, NULL);
-
- TValue new_str;
- /* the if isn't strictly necessary but it's clearer this way */
- if (pairs == 0) {
- return K->empty_string;
- } else {
- new_str = kstring_new_s(K, pairs);
- char *buf = kstring_buf(new_str);
- TValue tail = ls;
- while(pairs--) {
- *buf++ = chvalue(kcar(tail));
- tail = kcdr(tail);
- }
- return new_str;
- }
-}
-
/* 13.2.1? string */
void string(klisp_State *K)
{
@@ -172,7 +148,10 @@ void string(klisp_State *K)
UNUSED(xparams);
UNUSED(denv);
- TValue new_str = list_to_string_h(K, "string", ptree);
+ /* don't allow cycles */
+ int32_t pairs;
+ check_typed_list(K, kcharp, false, ptree, &pairs, NULL);
+ TValue new_str = list_to_string_h(K, ptree, pairs);
kapply_cc(K, new_str);
}
@@ -427,18 +406,8 @@ void string_to_list(klisp_State *K)
UNUSED(denv);
bind_1tp(K, ptree, "string", ttisstring, str);
- int32_t pairs = kstring_size(str);
- char *buf = kstring_buf(str);
-
- TValue tail = kget_dummy1(K);
-
- while(pairs--) {
- TValue new_pair = kcons(K, ch2tv(*buf), KNIL);
- buf++;
- kset_cdr(tail, new_pair);
- tail = new_pair;
- }
- kapply_cc(K, kcutoff_dummy1(K));
+ TValue res = string_to_list_h(K, str, NULL);
+ kapply_cc(K, res);
}
void list_to_string(klisp_State *K)
@@ -450,10 +419,12 @@ void list_to_string(klisp_State *K)
UNUSED(xparams);
UNUSED(denv);
- /* check later in list_to_string_h */
+ /* check later */
bind_1p(K, ptree, ls);
-
- TValue new_str = list_to_string_h(K, "list->string", ls);
+ /* don't allow cycles */
+ int32_t pairs;
+ check_typed_list(K, kcharp, false, ls, &pairs, NULL);
+ TValue new_str = list_to_string_h(K, ls, pairs);
kapply_cc(K, new_str);
}
diff --git a/src/kgvectors.c b/src/kgvectors.c
@@ -132,31 +132,16 @@ void vector_copy(klisp_State *K)
kapply_cc(K, new_vector);
}
-static TValue list_to_vector_h(klisp_State *K, const char *name, TValue ls)
-{
- /* don't allow cycles */
- int32_t pairs;
- check_list(K, false, ls, &pairs, NULL);
-
- if (pairs == 0) {
- return K->empty_vector;
- } else {
- TValue res = kvector_new_sf(K, pairs, KINERT);
- for (int i = 0; i < pairs; i++) {
- kvector_buf(res)[i] = kcar(ls);
- ls = kcdr(ls);
- }
- return res;
- }
-}
-
/* (R7RS 3rd draft 6.3.6) vector */
void vector(klisp_State *K)
{
klisp_assert(ttisenvironment(K->next_env));
TValue ptree = K->next_value;
- TValue res = list_to_vector_h(K, "vector", ptree);
+ /* don't allow cycles */
+ int32_t pairs;
+ check_list(K, false, ptree, &pairs, NULL);
+ TValue res = list_to_vector_h(K, ptree, pairs);
kapply_cc(K, res);
}
@@ -167,7 +152,10 @@ void list_to_vector(klisp_State *K)
TValue ptree = K->next_value;
bind_1p(K, ptree, ls);
- TValue res = list_to_vector_h(K, "list->vector", ls);
+ /* don't allow cycles */
+ int32_t pairs;
+ check_list(K, false, ls, &pairs, NULL);
+ TValue res = list_to_vector_h(K, ls, pairs);
kapply_cc(K, res);
}
@@ -179,13 +167,8 @@ void vector_to_list(klisp_State *K)
TValue ptree = K->next_value;
bind_1tp(K, ptree, "vector", ttisvector, v);
- TValue tail = KNIL;
- krooted_vars_push(K, &tail);
- size_t i = kvector_size(v);
- while (i-- > 0)
- tail = kcons(K, kvector_buf(v)[i], tail);
- krooted_vars_pop(K);
- kapply_cc(K, tail);
+ TValue res = vector_to_list_h(K, v, NULL);
+ kapply_cc(K, res);
}
/* 13.? bytevector->vector, vector->bytevector */
diff --git a/src/kpair.h b/src/kpair.h
@@ -102,6 +102,9 @@ TValue klist_g(klisp_State *K, bool m, int32_t n, ...);
#define klist(K_, n_, ...) (klist_g(K_, true, n_, __VA_ARGS__))
#define kimm_list(K_, n_, ...) (klist_g(K_, false, n_, __VA_ARGS__))
+/* TODO/REFACTOR: delete these functions, instead use
+ a pushed var */
+
inline TValue kget_dummy1(klisp_State *K)
{
klisp_assert(ttispair(K->dummy_pair1) && ttisnil(kcdr(K->dummy_pair1)));
diff --git a/src/tests/combiners.k b/src/tests/combiners.k
@@ -223,6 +223,91 @@
. #0#))
(list #f #f #f #f))
+;; string-map
+($check-predicate (applicative? string-map))
+($check equal? (string-map char-downcase "") "")
+($check equal? (string-map char-upcase "abc") "ABC")
+($let ((char-max ($lambda chars
+ (integer->char
+ (apply max
+ (map char->integer chars))))))
+ ($check equal? (string-map char-max "abc" "ABC" "xyz" "XYZ")
+ "xyz")
+ ($check equal? (string-map char-max "abc" "ABC" . #0=("xyz" "XYZ". #0#))
+ "xyz"))
+
+($let ((p (cons () ())))
+ ($check eq?
+ ($sequence (string-map (wrap ($vau #ignore env
+ (set-car! p env)
+ #\a))
+ "a")
+ (car p))
+ (get-current-environment)))
+
+($let ((p (cons 0 ())))
+ ($check eq?
+ ($sequence (string-map ($lambda (x)
+ (set-car! p (+ (car p) (char->integer x)))
+ #\a)
+ "abcd")
+ (car p))
+ (apply + (map char->integer (string->list "abcd")))))
+
+;; vector-map
+($check-predicate (applicative? vector-map))
+($check equal? (vector-map inert? (vector #inert #ignore #inert))
+ (vector #t #f #t))
+($check equal? (vector-map inert? (vector)) (vector))
+($check equal? (vector-map max (vector 1 2) .
+ #0=((vector 3 4) (vector 5 6). #0#))
+ (vector 5 6))
+
+($let ((p (cons () ())))
+ ($check eq?
+ ($sequence (vector-map (wrap ($vau #ignore env
+ (set-car! p env)))
+ (vector 1))
+ (car p))
+ (get-current-environment)))
+
+($let ((p (cons 0 ())))
+ ($check eq?
+ ($sequence (vector-map ($lambda (x)
+ (set-car! p (+ (car p) x)))
+ (vector 1 2 3 4))
+ (car p))
+ 10))
+
+;; bytevector-map
+($check-predicate (applicative? bytevector-map))
+($check equal? (bytevector-map + (bytevector)) (bytevector))
+($check equal? (bytevector-map ($lambda (x) (+ x 1)) (bytevector 1 2 3))
+ (bytevector 2 3 4))
+($check equal? (bytevector-map max (bytevector 1 2) (bytevector 3 4)
+ (bytevector 5 6))
+ (bytevector 5 6))
+($check equal? (bytevector-map max (bytevector 1 2) . #0=((bytevector 3 4)
+ (bytevector 5 6) . #0#))
+ (bytevector 5 6))
+
+($let ((p (cons () ())))
+ ($check eq?
+ ($sequence (bytevector-map (wrap ($vau #ignore env
+ (set-car! p env)
+ 1))
+ (bytevector 1))
+ (car p))
+ (get-current-environment)))
+
+($let ((p (cons 0 ())))
+ ($check eq?
+ ($sequence (bytevector-map ($lambda (x)
+ (set-car! p (+ (car p) x))
+ 1)
+ (bytevector 1 2 3 4))
+ (car p))
+ 10))
;;;
;;; Error Checking and Robustness
@@ -318,3 +403,55 @@
($check-error (map list (list 1 2) #inert))
($check-error (map cons (list 1 2)))
+
+;; string-map
+($check-error (string-map))
+($check-error (string-map char-upcase)) ; the list can't be empty
+($check-error (string-map ($lambda ls #\a) "abc" "ab"))
+($check-error (string-map ($lambda ls #\a) "abc" . #0=("ab" . #0#)))
+
+($check-error (string-map char->number "abc"))
+($check-error (string-map char>=? "abc" "def"))
+
+($check-error (string-map char-upcase #\a))
+($check-error (string-map char-upcase (list #\a)))
+($check-error (string-map #inert "abc"))
+($check-error (string-map (unwrap char-upcase) "abc"))
+($check-error (string-map char-upcase "abc" "def"))
+($check-error (string-map char-upcase . #0=("abc". #0#)))
+
+;; vector-map
+($check-error (vector-map))
+($check-error (vector-map char-upcase)) ; the list can't be empty
+($check-error (vector-map + (vector 1 2 3) (vector 1 2)))
+($check-error (vector-map + (vector 1 2 3) . #0=((vector 1 2) . #0#)))
+
+($check-error (vector-map char-upcase #\a))
+($check-error (vector-map char-upcase (list #\a)))
+($check-error (vector-map + (bytevector 1)))
+($check-error (vector-map #inert (vector)))
+($check-error (vector-map (unwrap +) (vector 1 2 3)))
+($check-error (vector-map ($lambda (x) (+ x 1))
+ (vector 1 2) (vector 1 2)))
+($check-error (vector-map ($lambda (x) (+ x 1)) .
+ #0=((vector 1 2) . #0#)))
+
+;; bytevector-map
+($check-error (bytevector-map))
+($check-error (bytevector-map +)) ; the list can't be empty
+($check-error (bytevector-map + (bytevector 1 2) (bytevector 1 2 3)))
+($check-error (bytevector-map + (bytevector 1 2) .
+ #0=((bytevector 1 2 3) . #0#)))
+
+($check-error (bytevector-map number->char (bytevector 41 42 43)))
+($check-error (bytevector-map + (bytevector 100 200) (bytevector 300 400)))
+
+($check-error (bytevector-map + 1))
+($check-error (bytevector-map + (list 1)))
+($check-error (bytevector-map + (vector 1)))
+($check-error (bytevector-map #inert (bytevector 1 2 3)))
+($check-error (bytevector-map (unwrap char-upcase) (bytevector 1 2 3)))
+($check-error (bytevector-map ($lambda (x) (+ x 1))
+ (bytevector 1 2 3) (bytevector 1 2 3)))
+($check-error (bytevector-map ($lambda (x) (+ x 1)) .
+ #0=((bytevector 1 2 3) . #0#)))
