string.c (3204B)
1 /* zlib License 2 * 3 * Copyright (c) 2017-2020 Ed van Bruggen 4 * 5 * This software is provided 'as-is', without any express or implied 6 * warranty. In no event will the authors be held liable for any damages 7 * arising from the use of this software. 8 * 9 * Permission is granted to anyone to use this software for any purpose, 10 * including commercial applications, and to alter it and redistribute it 11 * freely, subject to the following restrictions: 12 * 13 * 1. The origin of this software must not be misrepresented; you must not 14 * claim that you wrote the original software. If you use this software 15 * in a product, an acknowledgment in the product documentation would be 16 * appreciated but is not required. 17 * 2. Altered source versions must be plainly marked as such, and must not be 18 * misrepresented as being the original software. 19 * 3. This notice may not be removed or altered from any source distribution. 20 */ 21 #include <string.h> 22 #include <stdio.h> 23 #include <stdlib.h> 24 25 #include "../tisp.h" 26 27 typedef Val (*MkFn)(Tsp, char*); 28 29 /* TODO string tib: lower upper strpos strsub */ 30 31 /* TODO simplify by using fmemopen/funopen and tisp_print */ 32 static Val 33 val_string(Tsp st, Val args, MkFn mk_fn) 34 { 35 Val v; 36 char s[43], *ret = calloc(1, sizeof(char)); 37 int len = 1; 38 for (; !nilp(args); args = cdr(args)) { 39 v = car(args); 40 switch (v->t) { 41 case NONE: 42 len += 5; 43 ret = realloc(ret, len*sizeof(char)); 44 strcat(ret, "void"); 45 break; 46 case NIL: 47 len += 4; 48 ret = realloc(ret, len*sizeof(char)); 49 strcat(ret, "nil"); 50 break; 51 case INTEGER: 52 snprintf(s, 21, "%d", (int)v->v.n.num); 53 len += strlen(s); 54 s[len] = '\0'; 55 ret = realloc(ret, len*sizeof(char)); 56 strcat(ret, s); 57 break; 58 case DECIMAL: 59 snprintf(s, 17, "%.15g", v->v.n.num); 60 len += strlen(s); 61 s[len] = '\0'; 62 ret = realloc(ret, len*sizeof(char)); 63 strcat(ret, s); 64 break; 65 case RATIO: 66 snprintf(s, 43, "%d/%d", (int)v->v.n.num, (int)v->v.n.den); 67 len += strlen(s); 68 s[len] = '\0'; 69 ret = realloc(ret, len*sizeof(char)); 70 strcat(ret, s); 71 break; 72 case STRING: 73 case SYMBOL: 74 len += strlen(v->v.s); 75 ret = realloc(ret, len*sizeof(char)); 76 strcat(ret, v->v.s); 77 break; 78 case PAIR: 79 default: 80 tsp_warnf("could not convert type %s into string", type_str(v->t)); 81 } 82 } 83 v = mk_fn(st, ret); 84 free(ret); 85 return v; 86 } 87 88 /* TODO string and symbol: multi arguments to concat */ 89 static Val 90 prim_string(Tsp st, Hash env, Val args) 91 { 92 Val v; 93 tsp_arg_min(args, "string", 1); 94 if (!(v = tisp_eval_list(st, env, args))) 95 return NULL; 96 return val_string(st, v, mk_str); 97 } 98 99 static Val 100 prim_symbol(Tsp st, Hash env, Val args) 101 { 102 Val v; 103 tsp_arg_min(args, "symbol", 1); 104 if (!(v = tisp_eval_list(st, env, args))) 105 return NULL; 106 return val_string(st, v, mk_sym); 107 } 108 109 static Val 110 prim_strlen(Tsp st, Hash env, Val args) 111 { 112 Val v; 113 tsp_arg_num(args, "symbol", 1); 114 if (!(v = tisp_eval(st, env, car(args)))) 115 return NULL; 116 if (!(v->t & (STRING|SYMBOL))) 117 tsp_warnf("strlen: expected string or symbol, received %s", 118 type_str(v->t)); 119 return mk_int(strlen(v->v.s)); 120 } 121 122 void 123 tib_env_string(Tsp st) 124 { 125 tsp_env_fn(symbol); 126 tsp_env_fn(string); 127 tsp_env_fn(strlen); 128 }