klisp

an open source interpreter for the Kernel Programming Language.
git clone http://git.hanabi.in/repos/klisp.git
Log | Files | Refs | README

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 }