kgstrings.c (21460B)
1 /* 2 ** kgstrings.c 3 ** Strings features for the ground environment 4 ** See Copyright Notice in klisp.h 5 */ 6 7 #include <assert.h> 8 #include <stdio.h> 9 #include <string.h> 10 #include <stdlib.h> 11 #include <stdbool.h> 12 #include <stdint.h> 13 #include <ctype.h> 14 15 #include "kstate.h" 16 #include "kobject.h" 17 #include "kapplicative.h" 18 #include "koperative.h" 19 #include "kcontinuation.h" 20 #include "kerror.h" 21 #include "ksymbol.h" 22 #include "kchar.h" 23 #include "kstring.h" 24 #include "kvector.h" 25 #include "kbytevector.h" 26 27 #include "kghelpers.h" 28 #include "kgstrings.h" 29 30 /* 13.1.1? string? */ 31 /* uses typep */ 32 33 /* 13.1.? immutable-string?, mutable-string? */ 34 /* use ftypep */ 35 36 /* 13.1.2? make-string */ 37 void make_string(klisp_State *K) 38 { 39 TValue *xparams = K->next_xparams; 40 TValue ptree = K->next_value; 41 TValue denv = K->next_env; 42 klisp_assert(ttisenvironment(K->next_env)); 43 UNUSED(xparams); 44 UNUSED(denv); 45 bind_al1tp(K, ptree, "exact integer", keintegerp, tv_s, 46 maybe_char); 47 48 char fill = ' '; 49 if (get_opt_tpar(K, maybe_char, "char", ttischar)) 50 fill = chvalue(maybe_char); 51 52 if (knegativep(tv_s)) { 53 klispE_throw_simple(K, "negative size"); 54 return; 55 } else if (!ttisfixint(tv_s)) { 56 klispE_throw_simple(K, "size is too big"); 57 return; 58 } 59 60 TValue new_str = kstring_new_sf(K, ivalue(tv_s), fill); 61 kapply_cc(K, new_str); 62 } 63 64 /* 13.1.3? string-length */ 65 void string_length(klisp_State *K) 66 { 67 TValue *xparams = K->next_xparams; 68 TValue ptree = K->next_value; 69 TValue denv = K->next_env; 70 klisp_assert(ttisenvironment(K->next_env)); 71 UNUSED(xparams); 72 UNUSED(denv); 73 bind_1tp(K, ptree, "string", ttisstring, str); 74 75 TValue res = i2tv(kstring_size(str)); 76 kapply_cc(K, res); 77 } 78 79 /* 13.1.4? string-ref */ 80 void string_ref(klisp_State *K) 81 { 82 TValue *xparams = K->next_xparams; 83 TValue ptree = K->next_value; 84 TValue denv = K->next_env; 85 klisp_assert(ttisenvironment(K->next_env)); 86 UNUSED(xparams); 87 UNUSED(denv); 88 bind_2tp(K, ptree, "string", ttisstring, str, 89 "exact integer", keintegerp, tv_i); 90 91 if (!ttisfixint(tv_i)) { 92 /* TODO show index */ 93 klispE_throw_simple(K, "index out of bounds"); 94 return; 95 } 96 int32_t i = ivalue(tv_i); 97 98 if (i < 0 || i >= kstring_size(str)) { 99 /* TODO show index */ 100 klispE_throw_simple(K, "index out of bounds"); 101 return; 102 } 103 104 TValue res = ch2tv(kstring_buf(str)[i]); 105 kapply_cc(K, res); 106 } 107 108 /* 13.1.5? string-set! */ 109 void string_setB(klisp_State *K) 110 { 111 TValue *xparams = K->next_xparams; 112 TValue ptree = K->next_value; 113 TValue denv = K->next_env; 114 klisp_assert(ttisenvironment(K->next_env)); 115 UNUSED(xparams); 116 UNUSED(denv); 117 bind_3tp(K, ptree, "string", ttisstring, str, 118 "exact integer", keintegerp, tv_i, "char", ttischar, tv_ch); 119 120 if (!ttisfixint(tv_i)) { 121 /* TODO show index */ 122 klispE_throw_simple(K, "index out of bounds"); 123 return; 124 } else if (kstring_immutablep(str)) { 125 klispE_throw_simple(K, "immutable string"); 126 return; 127 } 128 129 int32_t i = ivalue(tv_i); 130 131 if (i < 0 || i >= kstring_size(str)) { 132 /* TODO show index */ 133 klispE_throw_simple(K, "index out of bounds"); 134 return; 135 } 136 137 kstring_buf(str)[i] = chvalue(tv_ch); 138 kapply_cc(K, KINERT); 139 } 140 141 /* 13.2.1? string */ 142 void string(klisp_State *K) 143 { 144 TValue *xparams = K->next_xparams; 145 TValue ptree = K->next_value; 146 TValue denv = K->next_env; 147 klisp_assert(ttisenvironment(K->next_env)); 148 UNUSED(xparams); 149 UNUSED(denv); 150 151 /* don't allow cycles */ 152 int32_t pairs; 153 check_typed_list(K, kcharp, false, ptree, &pairs, NULL); 154 TValue new_str = list_to_string_h(K, ptree, pairs); 155 kapply_cc(K, new_str); 156 } 157 158 /* 13.?? string-upcase, string-downcase, string-titlecase, string-foldcase */ 159 /* this will work for upcase, downcase and foldcase (in ASCII) */ 160 void kstring_change_case(klisp_State *K) 161 { 162 TValue *xparams = K->next_xparams; 163 TValue ptree = K->next_value; 164 TValue denv = K->next_env; 165 klisp_assert(ttisenvironment(K->next_env)); 166 /* 167 ** xparams[0]: conversion fn 168 */ 169 UNUSED(denv); 170 bind_1tp(K, ptree, "string", ttisstring, str); 171 char (*fn)(char) = pvalue(xparams[0]); 172 int32_t size = kstring_size(str); 173 TValue res = kstring_new_bs(K, kstring_buf(str), size); 174 char *buf = kstring_buf(res); 175 for(int32_t i = 0; i < size; ++i, buf++) { 176 *buf = fn(*buf); 177 } 178 kapply_cc(K, res); 179 } 180 181 void kstring_title_case(klisp_State *K) 182 { 183 TValue *xparams = K->next_xparams; 184 TValue ptree = K->next_value; 185 TValue denv = K->next_env; 186 klisp_assert(ttisenvironment(K->next_env)); 187 UNUSED(xparams); 188 UNUSED(denv); 189 bind_1tp(K, ptree, "string", ttisstring, str); 190 uint32_t size = kstring_size(str); 191 TValue res = kstring_new_bs(K, kstring_buf(str), size); 192 char *buf = kstring_buf(res); 193 bool first = true; 194 while(size-- > 0) { 195 char ch = *buf; 196 if (ch == ' ') 197 first = true; 198 else if (!first) 199 *buf = tolower(ch); 200 else if (isalpha(ch)) { 201 /* only count as first letter something that can be capitalized */ 202 *buf = toupper(ch); 203 first = false; 204 } 205 ++buf; 206 } 207 kapply_cc(K, res); 208 } 209 210 /* 13.2.2? string=?, string-ci=? */ 211 /* use ftyped_bpredp */ 212 213 /* 13.2.3? string<?, string<=?, string>?, string>=? */ 214 /* use ftyped_bpredp */ 215 216 /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */ 217 /* use ftyped_bpredp */ 218 219 /* Helpers for binary predicates */ 220 /* XXX: this should probably be in file kstring.h */ 221 222 bool kstring_eqp(TValue str1, TValue str2) { 223 return tv_equal(str1, str2) || kstring_equalp(str1, str2); 224 } 225 226 bool kstring_ci_eqp(TValue str1, TValue str2) 227 { 228 int32_t size = kstring_size(str1); 229 if (kstring_size(str2) != size) 230 return false; 231 else { 232 char *buf1 = kstring_buf(str1); 233 char *buf2 = kstring_buf(str2); 234 235 while(size--) { 236 if (tolower(*buf1) != tolower(*buf2)) 237 return false; 238 buf1++, buf2++; 239 } 240 return true; 241 } 242 } 243 244 bool kstring_ltp(TValue str1, TValue str2) 245 { 246 int32_t size1 = kstring_size(str1); 247 int32_t size2 = kstring_size(str2); 248 249 int32_t min_size = size1 < size2? size1 : size2; 250 /* memcmp > 0 if str1 has a bigger char in first diff position */ 251 int res = memcmp(kstring_buf(str1), kstring_buf(str2), min_size); 252 253 return (res < 0 || (res == 0 && size1 < size2)); 254 } 255 256 bool kstring_lep(TValue str1, TValue str2) { return !kstring_ltp(str2, str1); } 257 bool kstring_gtp(TValue str1, TValue str2) { return kstring_ltp(str2, str1); } 258 bool kstring_gep(TValue str1, TValue str2) { return !kstring_ltp(str1, str2); } 259 260 bool kstring_ci_ltp(TValue str1, TValue str2) 261 { 262 int32_t size1 = kstring_size(str1); 263 int32_t size2 = kstring_size(str2); 264 int32_t min_size = size1 < size2? size1 : size2; 265 char *buf1 = kstring_buf(str1); 266 char *buf2 = kstring_buf(str2); 267 268 while(min_size--) { 269 int diff = (int) tolower(*buf1) - (int) tolower(*buf2); 270 if (diff > 0) 271 return false; 272 else if (diff < 0) 273 return true; 274 buf1++, buf2++; 275 } 276 return size1 < size2; 277 } 278 279 bool kstring_ci_lep(TValue str1, TValue str2) 280 { 281 return !kstring_ci_ltp(str2, str1); 282 } 283 284 bool kstring_ci_gtp(TValue str1, TValue str2) 285 { 286 return kstring_ci_ltp(str2, str1); 287 } 288 289 bool kstring_ci_gep(TValue str1, TValue str2) 290 { 291 return !kstring_ci_ltp(str1, str2); 292 } 293 294 /* 13.2.5? substring */ 295 /* TEMP: at least for now this always returns mutable strings (like in Racket and 296 following the Kernel Report where it says that object returned should be mutable 297 unless stated) */ 298 void substring(klisp_State *K) 299 { 300 TValue *xparams = K->next_xparams; 301 TValue ptree = K->next_value; 302 TValue denv = K->next_env; 303 klisp_assert(ttisenvironment(K->next_env)); 304 UNUSED(xparams); 305 UNUSED(denv); 306 bind_3tp(K, ptree, "string", ttisstring, str, 307 "exact integer", keintegerp, tv_start, 308 "exact integer", keintegerp, tv_end); 309 310 if (!ttisfixint(tv_start) || ivalue(tv_start) < 0 || 311 ivalue(tv_start) > kstring_size(str)) { 312 /* TODO show index */ 313 klispE_throw_simple(K, "start index out of bounds"); 314 return; 315 } 316 317 int32_t start = ivalue(tv_start); 318 319 if (!ttisfixint(tv_end) || ivalue(tv_end) < 0 || 320 ivalue(tv_end) > kstring_size(str)) { 321 klispE_throw_simple(K, "end index out of bounds"); 322 return; 323 } 324 325 int32_t end = ivalue(tv_end); 326 327 if (start > end) { 328 /* TODO show indexes */ 329 klispE_throw_simple(K, "end index is smaller than start index"); 330 return; 331 } 332 333 int32_t size = end - start; 334 TValue new_str; 335 /* the if isn't strictly necessary but it's clearer this way */ 336 if (size == 0) { 337 new_str = G(K)->empty_string; 338 } else { 339 /* always returns mutable strings */ 340 new_str = kstring_new_bs(K, kstring_buf(str)+start, size); 341 } 342 kapply_cc(K, new_str); 343 } 344 345 /* 13.2.6? string-append */ 346 /* TEMP: at least for now this always returns mutable strings */ 347 /* TEMP: this does 3 passes over the list */ 348 void string_append(klisp_State *K) 349 { 350 TValue *xparams = K->next_xparams; 351 TValue ptree = K->next_value; 352 TValue denv = K->next_env; 353 klisp_assert(ttisenvironment(K->next_env)); 354 UNUSED(xparams); 355 UNUSED(denv); 356 /* don't allow cycles */ 357 int32_t pairs; 358 check_typed_list(K, kstringp, false, ptree, &pairs, NULL); 359 360 TValue new_str; 361 int64_t total_size = 0; /* use int64 to check for overflow */ 362 /* the if isn't strictly necessary but it's clearer this way */ 363 int32_t saved_pairs = pairs; /* save pairs for next loop */ 364 TValue tail = ptree; 365 while(pairs--) { 366 total_size += kstring_size(kcar(tail)); 367 if (total_size > INT32_MAX) { 368 klispE_throw_simple(K, "resulting string is too big"); 369 return; 370 } 371 tail = kcdr(tail); 372 } 373 /* this is safe */ 374 int32_t size = (int32_t) total_size; 375 376 if (size == 0) { 377 new_str = G(K)->empty_string; 378 } else { 379 new_str = kstring_new_s(K, size); 380 char *buf = kstring_buf(new_str); 381 /* loop again to copy the chars of each string */ 382 tail = ptree; 383 pairs = saved_pairs; 384 385 while(pairs--) { 386 TValue first = kcar(tail); 387 int32_t first_size = kstring_size(first); 388 memcpy(buf, kstring_buf(first), first_size); 389 buf += first_size; 390 tail = kcdr(tail); 391 } 392 } 393 394 kapply_cc(K, new_str); 395 } 396 397 398 /* 13.2.7? string->list, list->string */ 399 void string_to_list(klisp_State *K) 400 { 401 TValue *xparams = K->next_xparams; 402 TValue ptree = K->next_value; 403 TValue denv = K->next_env; 404 klisp_assert(ttisenvironment(K->next_env)); 405 UNUSED(xparams); 406 UNUSED(denv); 407 408 bind_1tp(K, ptree, "string", ttisstring, str); 409 TValue res = string_to_list_h(K, str, NULL); 410 kapply_cc(K, res); 411 } 412 413 void list_to_string(klisp_State *K) 414 { 415 TValue *xparams = K->next_xparams; 416 TValue ptree = K->next_value; 417 TValue denv = K->next_env; 418 klisp_assert(ttisenvironment(K->next_env)); 419 UNUSED(xparams); 420 UNUSED(denv); 421 422 /* check later */ 423 bind_1p(K, ptree, ls); 424 /* don't allow cycles */ 425 int32_t pairs; 426 check_typed_list(K, kcharp, false, ls, &pairs, NULL); 427 TValue new_str = list_to_string_h(K, ls, pairs); 428 kapply_cc(K, new_str); 429 } 430 431 /* 13.? string->vector, vector->string */ 432 void string_to_vector(klisp_State *K) 433 { 434 TValue *xparams = K->next_xparams; 435 TValue ptree = K->next_value; 436 TValue denv = K->next_env; 437 klisp_assert(ttisenvironment(K->next_env)); 438 UNUSED(xparams); 439 UNUSED(denv); 440 441 bind_1tp(K, ptree, "string", ttisstring, str); 442 TValue res; 443 444 if (kstring_emptyp(str)) { 445 res = G(K)->empty_vector; 446 } else { 447 uint32_t size = kstring_size(str); 448 449 /* MAYBE add vector constructor without fill */ 450 /* no need to root this */ 451 res = kvector_new_sf(K, size, KINERT); 452 char *src = kstring_buf(str); 453 TValue *dst = kvector_buf(res); 454 while(size--) { 455 char ch = *src++; /* not needed but just in case */ 456 *dst++ = ch2tv(ch); 457 } 458 } 459 kapply_cc(K, res); 460 } 461 462 /* TEMP Only ASCII for now */ 463 void vector_to_string(klisp_State *K) 464 { 465 TValue *xparams = K->next_xparams; 466 TValue ptree = K->next_value; 467 TValue denv = K->next_env; 468 klisp_assert(ttisenvironment(K->next_env)); 469 UNUSED(xparams); 470 UNUSED(denv); 471 472 bind_1tp(K, ptree, "vector", ttisvector, vec); 473 TValue res; 474 475 if (kvector_emptyp(vec)) { 476 res = G(K)->empty_string; 477 } else { 478 uint32_t size = kvector_size(vec); 479 480 res = kstring_new_s(K, size); /* no need to root this */ 481 TValue *src = kvector_buf(vec); 482 char *dst = kstring_buf(res); 483 while(size--) { 484 TValue tv = *src++; 485 if (!ttischar(tv)) { 486 klispE_throw_simple_with_irritants(K, "Non char object found", 487 1, tv); 488 return; 489 } 490 *dst++ = chvalue(tv); 491 } 492 } 493 kapply_cc(K, res); 494 } 495 496 /* 13.? string->bytevector, bytevector->string */ 497 void string_to_bytevector(klisp_State *K) 498 { 499 TValue *xparams = K->next_xparams; 500 TValue ptree = K->next_value; 501 TValue denv = K->next_env; 502 klisp_assert(ttisenvironment(K->next_env)); 503 UNUSED(xparams); 504 UNUSED(denv); 505 506 bind_1tp(K, ptree, "string", ttisstring, str); 507 TValue res; 508 509 if (kstring_emptyp(str)) { 510 res = G(K)->empty_bytevector; 511 } else { 512 uint32_t size = kstring_size(str); 513 514 /* MAYBE add bytevector constructor without fill */ 515 /* no need to root this */ 516 res = kbytevector_new_s(K, size); 517 char *src = kstring_buf(str); 518 uint8_t *dst = kbytevector_buf(res); 519 520 while(size--) { 521 *dst++ = (uint8_t)*src++; 522 } 523 } 524 kapply_cc(K, res); 525 } 526 527 /* TEMP Only ASCII for now */ 528 void bytevector_to_string(klisp_State *K) 529 { 530 TValue *xparams = K->next_xparams; 531 TValue ptree = K->next_value; 532 TValue denv = K->next_env; 533 klisp_assert(ttisenvironment(K->next_env)); 534 UNUSED(xparams); 535 UNUSED(denv); 536 537 bind_1tp(K, ptree, "bytevector", ttisbytevector, bb); 538 TValue res; 539 540 if (kbytevector_emptyp(bb)) { 541 res = G(K)->empty_string; 542 } else { 543 uint32_t size = kbytevector_size(bb); 544 res = kstring_new_s(K, size); /* no need to root this */ 545 uint8_t *src = kbytevector_buf(bb); 546 char *dst = kstring_buf(res); 547 while(size--) { 548 uint8_t u8 = *src++; 549 if (u8 >= 128) { 550 klispE_throw_simple_with_irritants(K, "Char out of range", 551 1, i2tv(u8)); 552 return; 553 } 554 *dst++ = (char) u8; 555 } 556 } 557 kapply_cc(K, res); 558 } 559 560 /* 13.2.8? string-copy */ 561 /* TEMP: at least for now this always returns mutable strings */ 562 void string_copy(klisp_State *K) 563 { 564 TValue *xparams = K->next_xparams; 565 TValue ptree = K->next_value; 566 TValue denv = K->next_env; 567 klisp_assert(ttisenvironment(K->next_env)); 568 UNUSED(xparams); 569 UNUSED(denv); 570 bind_1tp(K, ptree, "string", ttisstring, str); 571 572 TValue new_str; 573 /* the if isn't strictly necessary but it's clearer this way */ 574 if (tv_equal(str, G(K)->empty_string)) { 575 new_str = str; 576 } else { 577 new_str = kstring_new_bs(K, kstring_buf(str), kstring_size(str)); 578 } 579 kapply_cc(K, new_str); 580 } 581 582 /* 13.2.9? string->immutable-string */ 583 void string_to_immutable_string(klisp_State *K) 584 { 585 TValue *xparams = K->next_xparams; 586 TValue ptree = K->next_value; 587 TValue denv = K->next_env; 588 klisp_assert(ttisenvironment(K->next_env)); 589 UNUSED(xparams); 590 UNUSED(denv); 591 bind_1tp(K, ptree, "string", ttisstring, str); 592 593 TValue res_str; 594 if (kstring_immutablep(str)) {/* this includes the empty list */ 595 res_str = str; 596 } else { 597 res_str = kstring_new_bs_imm(K, kstring_buf(str), kstring_size(str)); 598 } 599 kapply_cc(K, res_str); 600 } 601 602 /* 13.2.10? string-fill! */ 603 void string_fillB(klisp_State *K) 604 { 605 TValue *xparams = K->next_xparams; 606 TValue ptree = K->next_value; 607 TValue denv = K->next_env; 608 klisp_assert(ttisenvironment(K->next_env)); 609 UNUSED(xparams); 610 UNUSED(denv); 611 bind_2tp(K, ptree, "string", ttisstring, str, 612 "char", ttischar, tv_ch); 613 614 if (kstring_immutablep(str)) { 615 klispE_throw_simple(K, "immutable string"); 616 return; 617 } 618 619 memset(kstring_buf(str), chvalue(tv_ch), kstring_size(str)); 620 kapply_cc(K, KINERT); 621 } 622 623 /* init ground */ 624 void kinit_strings_ground_env(klisp_State *K) 625 { 626 TValue ground_env = G(K)->ground_env; 627 TValue symbol, value; 628 629 /* 630 ** This section is still missing from the report. The bindings here are 631 ** taken from r5rs scheme and should not be considered standard. They are 632 ** provided in the meantime to allow programs to use string features 633 ** (ASCII only). 634 */ 635 636 /* 13.1.1? string? */ 637 add_applicative(K, ground_env, "string?", typep, 2, symbol, 638 i2tv(K_TSTRING)); 639 /* 13.? immutable-string?, mutable-string? */ 640 add_applicative(K, ground_env, "immutable-string?", ftypep, 2, symbol, 641 p2tv(kimmutable_stringp)); 642 add_applicative(K, ground_env, "mutable-string?", ftypep, 2, symbol, 643 p2tv(kmutable_stringp)); 644 /* 13.1.2? make-string */ 645 add_applicative(K, ground_env, "make-string", make_string, 0); 646 /* 13.1.3? string-length */ 647 add_applicative(K, ground_env, "string-length", string_length, 0); 648 /* 13.1.4? string-ref */ 649 add_applicative(K, ground_env, "string-ref", string_ref, 0); 650 /* 13.1.5? string-set! */ 651 add_applicative(K, ground_env, "string-set!", string_setB, 0); 652 /* 13.2.1? string */ 653 add_applicative(K, ground_env, "string", string, 0); 654 /* 13.?? string-upcase, string-downcase, string-titlecase, 655 string-foldcase */ 656 add_applicative(K, ground_env, "string-upcase", kstring_change_case, 1, 657 p2tv(toupper)); 658 add_applicative(K, ground_env, "string-downcase", kstring_change_case, 1, 659 p2tv(tolower)); 660 add_applicative(K, ground_env, "string-titlecase", kstring_title_case, 0); 661 add_applicative(K, ground_env, "string-foldcase", kstring_change_case, 1, 662 p2tv(tolower)); 663 /* 13.2.2? string=?, string-ci=? */ 664 add_applicative(K, ground_env, "string=?", ftyped_bpredp, 3, 665 symbol, p2tv(kstringp), p2tv(kstring_eqp)); 666 add_applicative(K, ground_env, "string-ci=?", ftyped_bpredp, 3, 667 symbol, p2tv(kstringp), p2tv(kstring_ci_eqp)); 668 /* 13.2.3? string<?, string<=?, string>?, string>=? */ 669 add_applicative(K, ground_env, "string<?", ftyped_bpredp, 3, 670 symbol, p2tv(kstringp), p2tv(kstring_ltp)); 671 add_applicative(K, ground_env, "string<=?", ftyped_bpredp, 3, 672 symbol, p2tv(kstringp), p2tv(kstring_lep)); 673 add_applicative(K, ground_env, "string>?", ftyped_bpredp, 3, 674 symbol, p2tv(kstringp), p2tv(kstring_gtp)); 675 add_applicative(K, ground_env, "string>=?", ftyped_bpredp, 3, 676 symbol, p2tv(kstringp), p2tv(kstring_gep)); 677 /* 13.2.4? string-ci<?, string-ci<=?, string-ci>?, string-ci>=? */ 678 add_applicative(K, ground_env, "string-ci<?", ftyped_bpredp, 3, 679 symbol, p2tv(kstringp), p2tv(kstring_ci_ltp)); 680 add_applicative(K, ground_env, "string-ci<=?", ftyped_bpredp, 3, 681 symbol, p2tv(kstringp), p2tv(kstring_ci_lep)); 682 add_applicative(K, ground_env, "string-ci>?", ftyped_bpredp, 3, 683 symbol, p2tv(kstringp), p2tv(kstring_ci_gtp)); 684 add_applicative(K, ground_env, "string-ci>=?", ftyped_bpredp, 3, 685 symbol, p2tv(kstringp), p2tv(kstring_ci_gep)); 686 /* 13.2.5? substring */ 687 add_applicative(K, ground_env, "substring", substring, 0); 688 /* 13.2.6? string-append */ 689 add_applicative(K, ground_env, "string-append", string_append, 0); 690 /* 13.2.7? string->list, list->string */ 691 add_applicative(K, ground_env, "string->list", string_to_list, 0); 692 add_applicative(K, ground_env, "list->string", list_to_string, 0); 693 /* 13.?? string->vector, vector->string */ 694 add_applicative(K, ground_env, "string->vector", string_to_vector, 0); 695 add_applicative(K, ground_env, "vector->string", vector_to_string, 0); 696 /* 13.?? string->bytevector, bytevector->string */ 697 add_applicative(K, ground_env, "string->bytevector", 698 string_to_bytevector, 0); 699 add_applicative(K, ground_env, "bytevector->string", 700 bytevector_to_string, 0); 701 /* 13.2.8? string-copy */ 702 add_applicative(K, ground_env, "string-copy", string_copy, 0); 703 /* 13.2.9? string->immutable-string */ 704 add_applicative(K, ground_env, "string->immutable-string", 705 string_to_immutable_string, 0); 706 707 /* 13.2.10? string-fill! */ 708 add_applicative(K, ground_env, "string-fill!", string_fillB, 0); 709 }