| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | /* | ||
| 2 | Copyright 2022, 2023 Joel Svensson svenssonjoel@yahoo.se | ||
| 3 | Copyright 2022, 2023 Benjamin Vedder | ||
| 4 | Copyright 2024 Rasmus Söderhielm rasmus.soderhielm@gmail.com | ||
| 5 | |||
| 6 | This program is free software: you can redistribute it and/or modify | ||
| 7 | it under the terms of the GNU General Public License as published by | ||
| 8 | the Free Software Foundation, either version 3 of the License, or | ||
| 9 | (at your option) any later version. | ||
| 10 | |||
| 11 | This program is distributed in the hope that it will be useful, | ||
| 12 | but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 13 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 14 | GNU General Public License for more details. | ||
| 15 | |||
| 16 | You should have received a copy of the GNU General Public License | ||
| 17 | along with this program. If not, see <http://www.gnu.org/licenses/>. | ||
| 18 | */ | ||
| 19 | |||
| 20 | #include "extensions.h" | ||
| 21 | #include "lbm_memory.h" | ||
| 22 | #include "heap.h" | ||
| 23 | #include "fundamental.h" | ||
| 24 | #include "lbm_c_interop.h" | ||
| 25 | #include "eval_cps.h" | ||
| 26 | #include "print.h" | ||
| 27 | |||
| 28 | #include <ctype.h> | ||
| 29 | |||
| 30 | #ifndef MIN | ||
| 31 | #define MIN(a,b) (((a)<(b))?(a):(b)) | ||
| 32 | #endif | ||
| 33 | #ifndef MAX | ||
| 34 | #define MAX(a,b) (((a)>(b))?(a):(b)) | ||
| 35 | #endif | ||
| 36 | |||
| 37 | static char print_val_buffer[256]; | ||
| 38 | |||
| 39 | static lbm_uint sym_left; | ||
| 40 | static lbm_uint sym_right; | ||
| 41 | |||
| 42 | ✗ | static size_t strlen_max(const char *s, size_t maxlen) { | |
| 43 | size_t i; | ||
| 44 | ✗ | for (i = 0; i < maxlen; i ++) { | |
| 45 | ✗ | if (s[i] == 0) break; | |
| 46 | } | ||
| 47 | ✗ | return i; | |
| 48 | } | ||
| 49 | |||
| 50 | 39674 | static lbm_value ext_str_from_n(lbm_value *args, lbm_uint argn) { | |
| 51 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 39674 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
39674 | if (argn != 1 && argn != 2) { |
| 52 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 53 | ✗ | return ENC_SYM_EERROR; | |
| 54 | } | ||
| 55 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 39674 times.
|
39674 | if (!lbm_is_number(args[0])) { |
| 56 | ✗ | return ENC_SYM_TERROR; | |
| 57 | } | ||
| 58 | |||
| 59 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 39674 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
|
39674 | if (argn == 2 && !lbm_is_array_r(args[1])) { |
| 60 | ✗ | return ENC_SYM_TERROR; | |
| 61 | } | ||
| 62 | |||
| 63 | 39674 | char *format = 0; | |
| 64 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 39674 times.
|
39674 | if (argn == 2) { |
| 65 | ✗ | format = lbm_dec_str(args[1]); | |
| 66 | } | ||
| 67 | |||
| 68 | char buffer[100]; | ||
| 69 | 39674 | size_t len = 0; | |
| 70 | |||
| 71 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 39674 times.
|
39674 | switch (lbm_type_of(args[0])) { |
| 72 | ✗ | case LBM_TYPE_FLOAT: | |
| 73 | ✗ | if (!format) { | |
| 74 | ✗ | format = "%g"; | |
| 75 | } | ||
| 76 | ✗ | len = (size_t)snprintf(buffer, sizeof(buffer), format, (double)lbm_dec_as_float(args[0])); | |
| 77 | ✗ | break; | |
| 78 | |||
| 79 | 39674 | default: | |
| 80 |
1/2✓ Branch 0 taken 39674 times.
✗ Branch 1 not taken.
|
39674 | if (!format) { |
| 81 | 39674 | format = "%d"; | |
| 82 | } | ||
| 83 | 39674 | len = (size_t)snprintf(buffer, sizeof(buffer), format, lbm_dec_as_i32(args[0])); | |
| 84 | 39674 | break; | |
| 85 | } | ||
| 86 | |||
| 87 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 39674 times.
|
39674 | if (len > sizeof(buffer)) { |
| 88 | ✗ | len = sizeof(buffer); | |
| 89 | } | ||
| 90 | |||
| 91 | lbm_value res; | ||
| 92 |
2/2✓ Branch 1 taken 39648 times.
✓ Branch 2 taken 26 times.
|
39674 | if (lbm_create_array(&res, len + 1)) { |
| 93 | 39648 | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res); | |
| 94 | 39648 | memcpy(arr->data, buffer, len); | |
| 95 | 39648 | ((char*)(arr->data))[len] = '\0'; | |
| 96 | 39648 | return res; | |
| 97 | } else { | ||
| 98 | 26 | return ENC_SYM_MERROR; | |
| 99 | } | ||
| 100 | } | ||
| 101 | |||
| 102 | // signature: (str-join strings [delim]) -> str | ||
| 103 | 95850 | static lbm_value ext_str_join(lbm_value *args, lbm_uint argn) { | |
| 104 | // This function does not check that the string arguments contain any | ||
| 105 | // terminating null bytes. | ||
| 106 | |||
| 107 |
3/4✓ Branch 0 taken 84180 times.
✓ Branch 1 taken 11670 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 84180 times.
|
95850 | if (argn != 1 && argn != 2) { |
| 108 | ✗ | lbm_set_error_reason((char *)lbm_error_str_num_args); | |
| 109 | ✗ | return ENC_SYM_EERROR; | |
| 110 | } | ||
| 111 | |||
| 112 | 95850 | size_t str_len = 0; | |
| 113 | 95850 | size_t str_count = 0; | |
| 114 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 95850 times.
|
95850 | if (!lbm_is_list(args[0])) { |
| 115 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 116 | ✗ | lbm_set_error_suspect(args[0]); | |
| 117 | ✗ | return ENC_SYM_TERROR; | |
| 118 | } | ||
| 119 |
2/2✓ Branch 1 taken 191728 times.
✓ Branch 2 taken 95850 times.
|
287578 | for (lbm_value current = args[0]; lbm_is_cons(current); current = lbm_cdr(current)) { |
| 120 | 191728 | char *str = lbm_dec_str(lbm_car(current)); | |
| 121 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 191728 times.
|
191728 | if (!str) { |
| 122 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 123 | ✗ | lbm_set_error_suspect(args[0]); | |
| 124 | ✗ | return ENC_SYM_TERROR; | |
| 125 | } | ||
| 126 | |||
| 127 | 191728 | str_len += (strlen(str)); | |
| 128 | 191728 | str_count += 1; | |
| 129 | } | ||
| 130 | |||
| 131 | 95850 | const char *delim = ""; | |
| 132 |
2/2✓ Branch 0 taken 84180 times.
✓ Branch 1 taken 11670 times.
|
95850 | if (argn >= 2) { |
| 133 | 84180 | delim = lbm_dec_str(args[1]); | |
| 134 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 84180 times.
|
84180 | if (!delim) { |
| 135 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 136 | ✗ | lbm_set_error_suspect(args[1]); | |
| 137 | ✗ | return ENC_SYM_TERROR; | |
| 138 | } | ||
| 139 | } | ||
| 140 | |||
| 141 | 95850 | size_t delim_len = strlen(delim); | |
| 142 |
2/2✓ Branch 0 taken 67790 times.
✓ Branch 1 taken 28060 times.
|
95850 | if (str_count > 0) { |
| 143 | 67790 | str_len += (str_count - 1) * delim_len; | |
| 144 | } | ||
| 145 | |||
| 146 | lbm_value result; | ||
| 147 |
2/2✓ Branch 1 taken 118 times.
✓ Branch 2 taken 95732 times.
|
95850 | if (!lbm_create_array(&result, str_len + 1)) { |
| 148 | 118 | return ENC_SYM_MERROR; | |
| 149 | } | ||
| 150 | 95732 | char *result_str = lbm_dec_str(result); | |
| 151 | |||
| 152 | 95732 | size_t i = 0; | |
| 153 | 95732 | size_t offset = 0; | |
| 154 |
2/2✓ Branch 1 taken 191492 times.
✓ Branch 2 taken 95732 times.
|
287224 | for (lbm_value current = args[0]; lbm_is_cons(current); current = lbm_cdr(current)) { |
| 155 | 191492 | const char *str = lbm_dec_str(lbm_car(current)); | |
| 156 | 191492 | size_t len = strlen(str); | |
| 157 | |||
| 158 | 191492 | memcpy(result_str + offset, str, len); | |
| 159 | 191492 | offset += len; | |
| 160 | |||
| 161 |
2/2✓ Branch 0 taken 123788 times.
✓ Branch 1 taken 67704 times.
|
191492 | if (i != str_count - 1) { |
| 162 | 123788 | memcpy(result_str + offset, delim, delim_len); | |
| 163 | 123788 | offset += delim_len; | |
| 164 | } | ||
| 165 | 191492 | i++; | |
| 166 | } | ||
| 167 | |||
| 168 | 95732 | result_str[str_len] = '\0'; | |
| 169 | |||
| 170 | 95732 | return result; | |
| 171 | } | ||
| 172 | |||
| 173 | 308 | static lbm_value ext_str_to_i(lbm_value *args, lbm_uint argn) { | |
| 174 |
1/4✗ Branch 0 not taken.
✓ Branch 1 taken 308 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
|
308 | if (argn != 1 && argn != 2) { |
| 175 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 176 | ✗ | return ENC_SYM_EERROR; | |
| 177 | } | ||
| 178 | |||
| 179 | 308 | char *str = lbm_dec_str(args[0]); | |
| 180 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 308 times.
|
308 | if (!str) { |
| 181 | ✗ | return ENC_SYM_TERROR; | |
| 182 | } | ||
| 183 | |||
| 184 | 308 | int base = 0; | |
| 185 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 308 times.
|
308 | if (argn == 2) { |
| 186 | ✗ | if (!lbm_is_number(args[1])) { | |
| 187 | ✗ | return ENC_SYM_TERROR; | |
| 188 | } | ||
| 189 | |||
| 190 | ✗ | base = (int)lbm_dec_as_u32(args[1]); | |
| 191 | } | ||
| 192 | |||
| 193 | 308 | return lbm_enc_i32((int32_t)strtol(str, NULL, base)); | |
| 194 | } | ||
| 195 | |||
| 196 | ✗ | static lbm_value ext_str_to_f(lbm_value *args, lbm_uint argn) { | |
| 197 | ✗ | if (argn != 1) { | |
| 198 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 199 | ✗ | return ENC_SYM_EERROR; | |
| 200 | } | ||
| 201 | |||
| 202 | ✗ | char *str = lbm_dec_str(args[0]); | |
| 203 | ✗ | if (!str) { | |
| 204 | ✗ | return ENC_SYM_TERROR; | |
| 205 | } | ||
| 206 | |||
| 207 | ✗ | return lbm_enc_float(strtof(str, NULL)); | |
| 208 | } | ||
| 209 | |||
| 210 | ✗ | static lbm_value ext_str_part(lbm_value *args, lbm_uint argn) { | |
| 211 | ✗ | if ((argn != 2 && argn != 3) || !lbm_is_number(args[1])) { | |
| 212 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 213 | ✗ | return ENC_SYM_TERROR; | |
| 214 | } | ||
| 215 | |||
| 216 | ✗ | char *str = lbm_dec_str(args[0]); | |
| 217 | ✗ | if (!str) { | |
| 218 | ✗ | return ENC_SYM_TERROR; | |
| 219 | } | ||
| 220 | |||
| 221 | ✗ | uint32_t len = (uint32_t)strlen(str); | |
| 222 | |||
| 223 | ✗ | uint32_t start = lbm_dec_as_u32(args[1]); | |
| 224 | |||
| 225 | ✗ | if (start >= len) { | |
| 226 | ✗ | return ENC_SYM_EERROR; | |
| 227 | } | ||
| 228 | |||
| 229 | ✗ | uint32_t n = len - start; | |
| 230 | ✗ | if (argn == 3) { | |
| 231 | ✗ | if (!lbm_is_number(args[2])) { | |
| 232 | ✗ | return ENC_SYM_TERROR; | |
| 233 | } | ||
| 234 | |||
| 235 | ✗ | n = MIN(lbm_dec_as_u32(args[2]), n); | |
| 236 | } | ||
| 237 | |||
| 238 | lbm_value res; | ||
| 239 | ✗ | if (lbm_create_array(&res, n + 1)) { | |
| 240 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res); | |
| 241 | ✗ | memcpy(arr->data, str + start, n); | |
| 242 | ✗ | ((char*)(arr->data))[n] = '\0'; | |
| 243 | ✗ | return res; | |
| 244 | } else { | ||
| 245 | ✗ | return ENC_SYM_MERROR; | |
| 246 | } | ||
| 247 | } | ||
| 248 | |||
| 249 | ✗ | static lbm_value ext_str_split(lbm_value *args, lbm_uint argn) { | |
| 250 | ✗ | if (argn != 2) { | |
| 251 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 252 | ✗ | return ENC_SYM_EERROR; | |
| 253 | } | ||
| 254 | |||
| 255 | ✗ | char *str = lbm_dec_str(args[0]); | |
| 256 | ✗ | if (!str) { | |
| 257 | ✗ | return ENC_SYM_TERROR; | |
| 258 | } | ||
| 259 | |||
| 260 | ✗ | char *split = lbm_dec_str(args[1]); | |
| 261 | ✗ | int step = 0; | |
| 262 | ✗ | if (!split) { | |
| 263 | ✗ | if (lbm_is_number(args[1])) { | |
| 264 | ✗ | step = MAX(lbm_dec_as_i32(args[1]), 1); | |
| 265 | ✗ | lbm_value res = ENC_SYM_NIL; | |
| 266 | ✗ | int len = (int)strlen(str); | |
| 267 | ✗ | for (int i = len / step;i >= 0;i--) { | |
| 268 | ✗ | int ind_now = i * step; | |
| 269 | ✗ | if (ind_now >= len) { | |
| 270 | ✗ | continue; | |
| 271 | } | ||
| 272 | |||
| 273 | ✗ | int step_now = step; | |
| 274 | ✗ | while ((ind_now + step_now) > len) { | |
| 275 | ✗ | step_now--; | |
| 276 | } | ||
| 277 | |||
| 278 | lbm_value tok; | ||
| 279 | ✗ | if (lbm_create_array(&tok, (lbm_uint)step_now + 1)) { | |
| 280 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(tok); | |
| 281 | ✗ | memcpy(arr->data, str + ind_now, (unsigned int)step_now); | |
| 282 | ✗ | ((char*)(arr->data))[step_now] = '\0'; | |
| 283 | ✗ | res = lbm_cons(tok, res); | |
| 284 | } else { | ||
| 285 | ✗ | return ENC_SYM_MERROR; | |
| 286 | } | ||
| 287 | } | ||
| 288 | ✗ | return res; | |
| 289 | } else { | ||
| 290 | ✗ | return ENC_SYM_TERROR; | |
| 291 | } | ||
| 292 | } else { | ||
| 293 | ✗ | lbm_value res = ENC_SYM_NIL; | |
| 294 | ✗ | const char *s = str; | |
| 295 | ✗ | while (*(s += strspn(s, split)) != '\0') { | |
| 296 | ✗ | size_t len = strcspn(s, split); | |
| 297 | |||
| 298 | lbm_value tok; | ||
| 299 | ✗ | if (lbm_create_array(&tok, len + 1)) { | |
| 300 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(tok); | |
| 301 | ✗ | memcpy(arr->data, s, len); | |
| 302 | ✗ | ((char*)(arr->data))[len] = '\0'; | |
| 303 | ✗ | res = lbm_cons(tok, res); | |
| 304 | } else { | ||
| 305 | ✗ | return ENC_SYM_MERROR; | |
| 306 | } | ||
| 307 | ✗ | s += len; | |
| 308 | } | ||
| 309 | ✗ | return lbm_list_destructive_reverse(res); | |
| 310 | } | ||
| 311 | } | ||
| 312 | |||
| 313 | // Todo: Clean this up for 64bit | ||
| 314 | ✗ | static lbm_value ext_str_replace(lbm_value *args, lbm_uint argn) { | |
| 315 | ✗ | if (argn != 2 && argn != 3) { | |
| 316 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 317 | ✗ | return ENC_SYM_EERROR; | |
| 318 | } | ||
| 319 | |||
| 320 | ✗ | char *orig = lbm_dec_str(args[0]); | |
| 321 | ✗ | if (!orig) { | |
| 322 | ✗ | return ENC_SYM_TERROR; | |
| 323 | } | ||
| 324 | |||
| 325 | ✗ | char *rep = lbm_dec_str(args[1]); | |
| 326 | ✗ | if (!rep) { | |
| 327 | ✗ | return ENC_SYM_TERROR; | |
| 328 | } | ||
| 329 | |||
| 330 | ✗ | char *with = ""; | |
| 331 | ✗ | if (argn == 3) { | |
| 332 | ✗ | with = lbm_dec_str(args[2]); | |
| 333 | ✗ | if (!with) { | |
| 334 | ✗ | return ENC_SYM_TERROR; | |
| 335 | } | ||
| 336 | } | ||
| 337 | |||
| 338 | // See https://stackoverflow.com/questions/779875/what-function-is-to-replace-a-substring-from-a-string-in-c | ||
| 339 | //char *result; // the return string | ||
| 340 | char *ins; // the next insert point | ||
| 341 | char *tmp; // varies | ||
| 342 | size_t len_rep; // length of rep (the string to remove) | ||
| 343 | size_t len_with; // length of with (the string to replace rep with) | ||
| 344 | size_t len_front; // distance between rep and end of last rep | ||
| 345 | int count; // number of replacements | ||
| 346 | |||
| 347 | ✗ | len_rep = strlen(rep); | |
| 348 | ✗ | if (len_rep == 0) { | |
| 349 | ✗ | return args[0]; // empty rep causes infinite loop during count | |
| 350 | } | ||
| 351 | |||
| 352 | ✗ | len_with = strlen(with); | |
| 353 | |||
| 354 | // count the number of replacements needed | ||
| 355 | ✗ | ins = orig; | |
| 356 | ✗ | for (count = 0; (tmp = strstr(ins, rep)); ++count) { | |
| 357 | ✗ | ins = tmp + len_rep; | |
| 358 | } | ||
| 359 | |||
| 360 | ✗ | size_t len_res = strlen(orig) + (len_with - len_rep) * (unsigned int)count + 1; | |
| 361 | lbm_value lbm_res; | ||
| 362 | ✗ | if (lbm_create_array(&lbm_res, len_res)) { | |
| 363 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res); | |
| 364 | ✗ | tmp = (char*)arr->data; | |
| 365 | } else { | ||
| 366 | ✗ | return ENC_SYM_MERROR; | |
| 367 | } | ||
| 368 | |||
| 369 | // first time through the loop, all the variable are set correctly | ||
| 370 | // from here on, | ||
| 371 | // tmp points to the end of the result string | ||
| 372 | // ins points to the next occurrence of rep in orig | ||
| 373 | // orig points to the remainder of orig after "end of rep" | ||
| 374 | ✗ | while (count--) { | |
| 375 | ✗ | ins = strstr(orig, rep); | |
| 376 | ✗ | len_front = (size_t)ins - (size_t)orig; | |
| 377 | ✗ | tmp = strncpy(tmp, orig, len_front) + len_front; | |
| 378 | ✗ | tmp = strcpy(tmp, with) + len_with; | |
| 379 | ✗ | orig += len_front + len_rep; // move to next "end of rep" | |
| 380 | } | ||
| 381 | ✗ | strcpy(tmp, orig); | |
| 382 | |||
| 383 | ✗ | return lbm_res; | |
| 384 | } | ||
| 385 | |||
| 386 | ✗ | static lbm_value ext_str_to_lower(lbm_value *args, lbm_uint argn) { | |
| 387 | ✗ | if (argn != 1) { | |
| 388 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 389 | ✗ | return ENC_SYM_EERROR; | |
| 390 | } | ||
| 391 | |||
| 392 | ✗ | char *orig = lbm_dec_str(args[0]); | |
| 393 | ✗ | if (!orig) { | |
| 394 | ✗ | return ENC_SYM_TERROR; | |
| 395 | } | ||
| 396 | |||
| 397 | ✗ | size_t len = strlen(orig); | |
| 398 | lbm_value lbm_res; | ||
| 399 | ✗ | if (lbm_create_array(&lbm_res, len + 1)) { | |
| 400 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res); | |
| 401 | ✗ | for (unsigned int i = 0;i < len;i++) { | |
| 402 | ✗ | ((char*)(arr->data))[i] = (char)tolower(orig[i]); | |
| 403 | } | ||
| 404 | ✗ | ((char*)(arr->data))[len] = '\0'; | |
| 405 | ✗ | return lbm_res; | |
| 406 | } else { | ||
| 407 | ✗ | return ENC_SYM_MERROR; | |
| 408 | } | ||
| 409 | } | ||
| 410 | |||
| 411 | ✗ | static lbm_value ext_str_to_upper(lbm_value *args, lbm_uint argn) { | |
| 412 | ✗ | if (argn != 1) { | |
| 413 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 414 | ✗ | return ENC_SYM_EERROR; | |
| 415 | } | ||
| 416 | |||
| 417 | ✗ | char *orig = lbm_dec_str(args[0]); | |
| 418 | ✗ | if (!orig) { | |
| 419 | ✗ | return ENC_SYM_TERROR; | |
| 420 | } | ||
| 421 | |||
| 422 | ✗ | int len = (int)strlen(orig); | |
| 423 | lbm_value lbm_res; | ||
| 424 | ✗ | if (lbm_create_array(&lbm_res, (lbm_uint)len + 1)) { | |
| 425 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res); | |
| 426 | ✗ | for (int i = 0;i < len;i++) { | |
| 427 | ✗ | ((char*)(arr->data))[i] = (char)toupper(orig[i]); | |
| 428 | } | ||
| 429 | ✗ | ((char*)(arr->data))[len] = '\0'; | |
| 430 | ✗ | return lbm_res; | |
| 431 | } else { | ||
| 432 | ✗ | return ENC_SYM_MERROR; | |
| 433 | } | ||
| 434 | } | ||
| 435 | |||
| 436 | ✗ | static lbm_value ext_str_cmp(lbm_value *args, lbm_uint argn) { | |
| 437 | ✗ | if (argn != 2 && argn != 3) { | |
| 438 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 439 | ✗ | return ENC_SYM_EERROR; | |
| 440 | } | ||
| 441 | |||
| 442 | ✗ | char *str1 = lbm_dec_str(args[0]); | |
| 443 | ✗ | if (!str1) { | |
| 444 | ✗ | return ENC_SYM_TERROR; | |
| 445 | } | ||
| 446 | |||
| 447 | ✗ | char *str2 = lbm_dec_str(args[1]); | |
| 448 | ✗ | if (!str2) { | |
| 449 | ✗ | return ENC_SYM_TERROR; | |
| 450 | } | ||
| 451 | |||
| 452 | ✗ | int n = -1; | |
| 453 | ✗ | if (argn == 3) { | |
| 454 | ✗ | if (!lbm_is_number(args[2])) { | |
| 455 | ✗ | return ENC_SYM_EERROR; | |
| 456 | } | ||
| 457 | |||
| 458 | ✗ | n = lbm_dec_as_i32(args[2]); | |
| 459 | } | ||
| 460 | |||
| 461 | ✗ | if (n > 0) { | |
| 462 | ✗ | return lbm_enc_i(strncmp(str1, str2, (unsigned int)n)); | |
| 463 | } else { | ||
| 464 | ✗ | return lbm_enc_i(strcmp(str1, str2)); | |
| 465 | } | ||
| 466 | } | ||
| 467 | |||
| 468 | |||
| 469 | |||
| 470 | // TODO: This is very similar to ext-print. Maybe they can share code. | ||
| 471 | 896 | static lbm_value to_str(char *delimiter, lbm_value *args, lbm_uint argn) { | |
| 472 | 896 | const int str_len = 300; | |
| 473 | 896 | char *str = lbm_malloc((lbm_uint)str_len); | |
| 474 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 896 times.
|
896 | if (!str) { |
| 475 | ✗ | return ENC_SYM_MERROR; | |
| 476 | } | ||
| 477 | |||
| 478 | 896 | int str_ofs = 0; | |
| 479 | |||
| 480 |
2/2✓ Branch 0 taken 924 times.
✓ Branch 1 taken 896 times.
|
1820 | for (lbm_uint i = 0; i < argn; i ++) { |
| 481 | 924 | lbm_value t = args[i]; | |
| 482 | 924 | int max = str_len - str_ofs - 1; | |
| 483 | |||
| 484 | char *arr_str; | ||
| 485 | 924 | int chars = 0; | |
| 486 | |||
| 487 |
2/2✓ Branch 1 taken 140 times.
✓ Branch 2 taken 784 times.
|
924 | if (lbm_value_is_printable_string(t, &arr_str)) { |
| 488 |
2/2✓ Branch 0 taken 112 times.
✓ Branch 1 taken 28 times.
|
140 | if (str_ofs == 0) { |
| 489 | 112 | chars = snprintf(str + str_ofs, (unsigned int)max, "%s", arr_str); | |
| 490 | } else { | ||
| 491 | 28 | chars = snprintf(str + str_ofs, (unsigned int)max, "%s%s", delimiter, arr_str); | |
| 492 | } | ||
| 493 | } else { | ||
| 494 | 784 | lbm_print_value(print_val_buffer, 256, t); | |
| 495 |
1/2✓ Branch 0 taken 784 times.
✗ Branch 1 not taken.
|
784 | if (str_ofs == 0) { |
| 496 | 784 | chars = snprintf(str + str_ofs, (unsigned int)max, "%s", print_val_buffer); | |
| 497 | } else { | ||
| 498 | ✗ | chars = snprintf(str + str_ofs, (unsigned int)max, "%s%s", delimiter, print_val_buffer); | |
| 499 | } | ||
| 500 | } | ||
| 501 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 924 times.
|
924 | if (chars >= max) { |
| 502 | ✗ | str_ofs += max; | |
| 503 | } else { | ||
| 504 | 924 | str_ofs += chars; | |
| 505 | } | ||
| 506 | } | ||
| 507 | |||
| 508 | lbm_value res; | ||
| 509 |
1/2✓ Branch 1 taken 896 times.
✗ Branch 2 not taken.
|
896 | if (lbm_create_array(&res, (lbm_uint)str_ofs + 1)) { |
| 510 | 896 | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(res); | |
| 511 | 896 | strncpy((char*)arr->data, str, (unsigned int)str_ofs + 1); | |
| 512 | 896 | lbm_free(str); | |
| 513 | 896 | return res; | |
| 514 | } else { | ||
| 515 | ✗ | lbm_free(str); | |
| 516 | ✗ | return ENC_SYM_MERROR; | |
| 517 | } | ||
| 518 | } | ||
| 519 | |||
| 520 | 896 | static lbm_value ext_to_str(lbm_value *args, lbm_uint argn) { | |
| 521 | 896 | return to_str(" ", args, argn); | |
| 522 | } | ||
| 523 | |||
| 524 | ✗ | static lbm_value ext_to_str_delim(lbm_value *args, lbm_uint argn) { | |
| 525 | ✗ | if (argn < 1) { | |
| 526 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 527 | ✗ | return ENC_SYM_EERROR; | |
| 528 | } | ||
| 529 | |||
| 530 | ✗ | char *delim = lbm_dec_str(args[0]); | |
| 531 | ✗ | if (!delim) { | |
| 532 | ✗ | return ENC_SYM_TERROR; | |
| 533 | } | ||
| 534 | |||
| 535 | ✗ | return to_str(delim, args + 1, argn - 1); | |
| 536 | } | ||
| 537 | |||
| 538 | ✗ | static lbm_value ext_str_len(lbm_value *args, lbm_uint argn) { | |
| 539 | ✗ | LBM_CHECK_ARGN(1); | |
| 540 | |||
| 541 | ✗ | char *str = lbm_dec_str(args[0]); | |
| 542 | ✗ | if (!str) { | |
| 543 | ✗ | return ENC_SYM_TERROR; | |
| 544 | } | ||
| 545 | |||
| 546 | ✗ | lbm_array_header_t *array = (lbm_array_header_t *)lbm_car(args[0]); | |
| 547 | |||
| 548 | ✗ | return lbm_enc_i((int)strlen_max(str, array->size)); | |
| 549 | } | ||
| 550 | |||
| 551 | ✗ | static lbm_value ext_str_replicate(lbm_value *args, lbm_uint argn) { | |
| 552 | ✗ | if (argn != 2) { | |
| 553 | ✗ | lbm_set_error_reason((char*)lbm_error_str_num_args); | |
| 554 | ✗ | return ENC_SYM_EERROR; | |
| 555 | } | ||
| 556 | |||
| 557 | ✗ | lbm_value res = ENC_SYM_TERROR; | |
| 558 | |||
| 559 | ✗ | if (lbm_is_number(args[0]) && | |
| 560 | ✗ | lbm_is_number(args[1])) { | |
| 561 | ✗ | uint32_t len = lbm_dec_as_u32(args[0]); | |
| 562 | ✗ | uint8_t c = lbm_dec_as_char(args[1]); | |
| 563 | |||
| 564 | lbm_value lbm_res; | ||
| 565 | ✗ | if (lbm_create_array(&lbm_res, len + 1)) { | |
| 566 | ✗ | lbm_array_header_t *arr = (lbm_array_header_t*)lbm_car(lbm_res); | |
| 567 | ✗ | for (unsigned int i = 0;i < len;i++) { | |
| 568 | ✗ | ((char*)(arr->data))[i] = (char)c; | |
| 569 | } | ||
| 570 | ✗ | ((char*)(arr->data))[len] = '\0'; | |
| 571 | ✗ | res = lbm_res; | |
| 572 | } else { | ||
| 573 | ✗ | res = ENC_SYM_MERROR; | |
| 574 | } | ||
| 575 | } | ||
| 576 | ✗ | return res; | |
| 577 | } | ||
| 578 | |||
| 579 | // signature: (str-find str:byte-array substr [start:int] [occurrence:int] [dir]) -> int | ||
| 580 | // where | ||
| 581 | // seq = string|(..string) | ||
| 582 | // dir = 'left|'right | ||
| 583 | 448 | static lbm_value ext_str_find(lbm_value *args, lbm_uint argn) { | |
| 584 |
2/4✓ Branch 0 taken 448 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 448 times.
|
448 | if (argn < 2 || 5 < argn) { |
| 585 | ✗ | lbm_set_error_reason((char *)lbm_error_str_num_args); | |
| 586 | ✗ | return ENC_SYM_EERROR; | |
| 587 | } | ||
| 588 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 448 times.
|
448 | if (!lbm_is_array_r(args[0])) { |
| 589 | ✗ | lbm_set_error_suspect(args[0]); | |
| 590 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 591 | ✗ | return ENC_SYM_TERROR; | |
| 592 | } | ||
| 593 | |||
| 594 | 448 | lbm_array_header_t *str_header = (lbm_array_header_t *)lbm_car(args[0]); | |
| 595 | 448 | const char *str = (const char *)str_header->data; | |
| 596 | 448 | lbm_int str_size = (lbm_int)str_header->size; | |
| 597 | |||
| 598 | // Guaranteed to be list containing strings. | ||
| 599 | lbm_value substrings; | ||
| 600 | 448 | lbm_int min_substr_len = LBM_INT_MAX; | |
| 601 |
2/2✓ Branch 1 taken 392 times.
✓ Branch 2 taken 56 times.
|
448 | if (lbm_is_array_r(args[1])) { |
| 602 | 392 | substrings = lbm_cons(args[1], ENC_SYM_NIL); | |
| 603 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 392 times.
|
392 | if (substrings == ENC_SYM_MERROR) { |
| 604 | ✗ | return ENC_SYM_MERROR; | |
| 605 | } | ||
| 606 | 392 | lbm_array_header_t *header = | |
| 607 | 392 | (lbm_array_header_t *)lbm_car(args[1]); | |
| 608 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 392 times.
|
392 | if (!header) { |
| 609 | // Should not be possible | ||
| 610 | ✗ | return ENC_SYM_FATAL_ERROR; | |
| 611 | } | ||
| 612 | |||
| 613 | 392 | lbm_int len = (lbm_int)header->size - 1; | |
| 614 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 392 times.
|
392 | if (len < 0) { |
| 615 | // substr is zero length array | ||
| 616 | ✗ | return lbm_enc_i(-1); | |
| 617 | } | ||
| 618 | 392 | min_substr_len = len; | |
| 619 |
1/2✓ Branch 1 taken 56 times.
✗ Branch 2 not taken.
|
56 | } else if (lbm_is_list(args[1])) { |
| 620 |
2/2✓ Branch 2 taken 56 times.
✓ Branch 3 taken 56 times.
|
112 | for (lbm_value current = args[1]; lbm_is_cons(current); current = lbm_cdr(current)) { |
| 621 |
1/2✗ Branch 2 not taken.
✓ Branch 3 taken 56 times.
|
56 | if (!lbm_is_array_r(lbm_car(current))) { |
| 622 | ✗ | lbm_set_error_suspect(args[1]); | |
| 623 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 624 | ✗ | return ENC_SYM_TERROR; | |
| 625 | } | ||
| 626 | |||
| 627 | 56 | lbm_array_header_t *header = | |
| 628 | 56 | (lbm_array_header_t *)lbm_car(lbm_car(current)); | |
| 629 | |||
| 630 | 56 | lbm_int len = (lbm_int)header->size - 1; | |
| 631 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 56 times.
|
56 | if (len < 0) { |
| 632 | // substr is zero length array | ||
| 633 | ✗ | continue; | |
| 634 | } | ||
| 635 |
2/2✓ Branch 0 taken 28 times.
✓ Branch 1 taken 28 times.
|
56 | if (len < min_substr_len) { |
| 636 | 28 | min_substr_len = len; | |
| 637 | } | ||
| 638 | } | ||
| 639 | 56 | substrings = args[1]; | |
| 640 | } else { | ||
| 641 | ✗ | lbm_set_error_suspect(args[1]); | |
| 642 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 643 | ✗ | return ENC_SYM_TERROR; | |
| 644 | } | ||
| 645 | |||
| 646 | 448 | bool to_right = true; | |
| 647 | 448 | lbm_uint dir_index = 4; | |
| 648 |
4/4✓ Branch 0 taken 280 times.
✓ Branch 1 taken 168 times.
✓ Branch 3 taken 112 times.
✓ Branch 4 taken 168 times.
|
448 | if (argn >= 3 && lbm_is_symbol(args[argn - 1])) { |
| 649 | 112 | dir_index = argn - 1; | |
| 650 | 112 | lbm_uint symbol = lbm_dec_sym(args[dir_index]); | |
| 651 | |||
| 652 |
2/2✓ Branch 0 taken 84 times.
✓ Branch 1 taken 28 times.
|
112 | if (symbol == sym_left) { |
| 653 | 84 | to_right = false; | |
| 654 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 28 times.
|
28 | } else if (symbol != sym_right) { |
| 655 | ✗ | lbm_set_error_suspect(args[dir_index]); | |
| 656 | ✗ | lbm_set_error_reason((char *)lbm_error_str_incorrect_arg); | |
| 657 | ✗ | return ENC_SYM_TERROR; | |
| 658 | } | ||
| 659 | } | ||
| 660 | |||
| 661 |
2/2✓ Branch 0 taken 364 times.
✓ Branch 1 taken 84 times.
|
448 | lbm_int start = to_right ? 0 : str_size - min_substr_len; |
| 662 |
4/4✓ Branch 0 taken 280 times.
✓ Branch 1 taken 168 times.
✓ Branch 2 taken 224 times.
✓ Branch 3 taken 56 times.
|
448 | if (argn >= 3 && dir_index != 2) { |
| 663 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 224 times.
|
224 | if (!lbm_is_number(args[2])) { |
| 664 | ✗ | lbm_set_error_reason((char *)lbm_error_str_no_number); | |
| 665 | ✗ | lbm_set_error_suspect(args[2]); | |
| 666 | ✗ | return ENC_SYM_TERROR; | |
| 667 | } | ||
| 668 | |||
| 669 | 224 | start = lbm_dec_as_int(args[2]); | |
| 670 | } | ||
| 671 | |||
| 672 | 448 | uint32_t occurrence = 0; | |
| 673 |
4/4✓ Branch 0 taken 84 times.
✓ Branch 1 taken 364 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 56 times.
|
448 | if (argn >= 4 && dir_index != 3) { |
| 674 |
1/2✗ Branch 1 not taken.
✓ Branch 2 taken 28 times.
|
28 | if (!lbm_is_number(args[3])) { |
| 675 | ✗ | lbm_set_error_reason((char *)lbm_error_str_no_number); | |
| 676 | ✗ | lbm_set_error_suspect(args[3]); | |
| 677 | ✗ | return ENC_SYM_TERROR; | |
| 678 | } | ||
| 679 | |||
| 680 | 28 | occurrence = lbm_dec_as_u32(args[3]); | |
| 681 | } | ||
| 682 | |||
| 683 |
2/2✓ Branch 0 taken 168 times.
✓ Branch 1 taken 280 times.
|
448 | if (start < 0) { |
| 684 | // start: -1 starts the search at the character index before the final null | ||
| 685 | // byte index. | ||
| 686 | 168 | start = str_size - 1 + start; | |
| 687 | } | ||
| 688 | |||
| 689 |
4/4✓ Branch 0 taken 84 times.
✓ Branch 1 taken 364 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 56 times.
|
448 | if (!to_right && (start > str_size - min_substr_len)) { |
| 690 | 28 | start = str_size - min_substr_len; | |
| 691 | } | ||
| 692 |
4/4✓ Branch 0 taken 364 times.
✓ Branch 1 taken 56 times.
✓ Branch 2 taken 28 times.
✓ Branch 3 taken 336 times.
|
420 | else if (to_right && (start < 0)) { |
| 693 | 28 | start = 0; | |
| 694 | } | ||
| 695 | |||
| 696 |
2/2✓ Branch 0 taken 364 times.
✓ Branch 1 taken 84 times.
|
448 | lbm_int dir = to_right ? 1 : -1; |
| 697 |
4/4✓ Branch 0 taken 504 times.
✓ Branch 1 taken 112 times.
✓ Branch 2 taken 476 times.
✓ Branch 3 taken 140 times.
|
616 | for (lbm_int i = start; to_right ? (i <= str_size - min_substr_len) : (i >= 0); i += dir) { |
| 698 |
2/2✓ Branch 2 taken 504 times.
✓ Branch 3 taken 168 times.
|
672 | for (lbm_value current = substrings; lbm_is_cons(current); current = lbm_cdr(current)) { |
| 699 | 504 | lbm_array_header_t *header = (lbm_array_header_t *)lbm_car(lbm_car(current)); | |
| 700 | 504 | lbm_int substr_len = (lbm_int)header->size - 1; | |
| 701 | 504 | const char *substr = (const char *)header->data; | |
| 702 | |||
| 703 | 504 | if ( | |
| 704 |
1/2✓ Branch 0 taken 504 times.
✗ Branch 1 not taken.
|
504 | i > str_size - substr_len // substr length runs over str end. |
| 705 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 504 times.
|
504 | || substr_len < 0 // substr was zero bytes in size |
| 706 | ) { | ||
| 707 | ✗ | continue; | |
| 708 | } | ||
| 709 | |||
| 710 |
2/2✓ Branch 0 taken 336 times.
✓ Branch 1 taken 168 times.
|
504 | if (memcmp(&str[i], substr, (size_t)substr_len) == 0) { |
| 711 |
2/2✓ Branch 0 taken 308 times.
✓ Branch 1 taken 28 times.
|
336 | if (occurrence == 0) { |
| 712 | 308 | return lbm_enc_i(i); | |
| 713 | } | ||
| 714 | 28 | occurrence -= 1; | |
| 715 | } | ||
| 716 | } | ||
| 717 | } | ||
| 718 | |||
| 719 | 140 | return lbm_enc_i(-1); | |
| 720 | } | ||
| 721 | |||
| 722 | 17444 | bool lbm_string_extensions_init(void) { | |
| 723 | |||
| 724 | 17444 | bool res = true; | |
| 725 | |||
| 726 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_symbol_const("left", &sym_left); |
| 727 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_symbol_const("right", &sym_right); |
| 728 | |||
| 729 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-from-n", ext_str_from_n); |
| 730 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-join", ext_str_join); |
| 731 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-to-i", ext_str_to_i); |
| 732 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-to-f", ext_str_to_f); |
| 733 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-part", ext_str_part); |
| 734 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-split", ext_str_split); |
| 735 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-replace", ext_str_replace); |
| 736 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-to-lower", ext_str_to_lower); |
| 737 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-to-upper", ext_str_to_upper); |
| 738 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-cmp", ext_str_cmp); |
| 739 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("to-str", ext_to_str); |
| 740 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("to-str-delim", ext_to_str_delim); |
| 741 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-len", ext_str_len); |
| 742 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-replicate", ext_str_replicate); |
| 743 |
2/4✓ Branch 0 taken 17444 times.
✗ Branch 1 not taken.
✓ Branch 3 taken 17444 times.
✗ Branch 4 not taken.
|
17444 | res = res && lbm_add_extension("str-find", ext_str_find); |
| 744 | |||
| 745 | 17444 | return res; | |
| 746 | } | ||
| 747 |