/*  string functions*/#include "sl.h"#include "operators.h"#include "cvalues.h"#include "print.h"#include "read.h"#include "equal.h"#include "io.h"#include "str.h" static const u8int ws[] = {	0x20, 0x0a, 0x09, 0x0b, 0x0c, 0x0d, 0xc2, 0x85,	0xc2, 0xa0, 0xe1, 0x9a, 0x80, 0xe2, 0x80, 0x80,	0xe2, 0x80, 0x81, 0xe2, 0x80, 0x82, 0xe2, 0x80,	0x83, 0xe2, 0x80, 0x84, 0xe2, 0x80, 0x85, 0xe2,	0x80, 0x86, 0xe2, 0x80, 0x87, 0xe2, 0x80, 0x88,	0xe2, 0x80, 0x89, 0xe2, 0x80, 0x8a, 0xe2, 0x80,	0xa8, 0xe2, 0x80, 0xa9, 0xe2, 0x80, 0xaf, 0xe2,	0x81, 0x9f, 0xe3, 0x80, 0x80, 0x00}; intisdigit_base(char c, int base){	if(base < 11)		return c >= '0' && c < '0'+base;	if(base == 32)		return (c >= 'A' && c <= 'Z') || (c >= '2' && c <= '7');	return (c >= '0' && c <= '9') || (c >= 'a' && c < 'a'+base-10) || (c >= 'A' && c < 'A'+base-10);} sl_purefnBUILTIN("str?", strp){	argcount(nargs, 1);	return isstr(args[0]) ? sl_t : sl_nil;} sl_purefnBUILTIN("str-width", str_width){	argcount(nargs, 1);	if(isrune(args[0])){		int w = sl_wcwidth(torune(args[0]));		return fixnum(w);	}	if(!isstr(args[0]))		bthrow(type_error(nil, "str", args[0]));	char *str = tostr(args[0]);	usize len = cv_len(ptr(args[0]));	bool err = false;	ssize w = u8_strwidth(str, len, &err);	return err ? sl_nil : fixnum(w);} BUILTIN("str-reverse", str_reverse){	argcount(nargs, 1);	if(isrune(args[0]))		return args[0];	if(!isstr(args[0]))		bthrow(type_error(nil, "str", args[0]));	usize len = cv_len(ptr(args[0]));	sl_v ns = cvalue_str(len);	u8_reverse(cvalue_data(ns), cvalue_data(args[0]), len);	return ns;} BUILTIN("str", str){	if(nargs == 1 && isstr(args[0]))		return args[0];	sl_v arg, buf = fn_builtin_buffer(nil, 0);	sl_gc_handle(&buf);	ios *s = value2c(ios*, buf);	sl_v oldpr = sym_value(sl_printreadablysym); // FIXME: gc if cvalue	sl_v oldpp = sym_value(sl_printprettysym); // FIXME: gc if cvalue	set(sl_printreadablysym, sl_nil);	set(sl_printprettysym, sl_nil);	int i;	FOR_ARGS(i, 0, arg, args){		USED(arg);		sl_print(s, args[i]);	}	set(sl_printreadablysym, oldpr);	set(sl_printprettysym, oldpp);	sl_v outp = io_to_str(&buf);	sl_free_gc_handles(1);	return outp;} BUILTIN("str-split", str_split){	if(nargs < 2)		argcount(nargs, 1);	char *s = tostr(args[0]);	usize len = cv_len(ptr(args[0]));	// split on whitespace by default	const char *delim0 = (const char*)ws, *delim = delim0;	usize dlen = 5;	int n = 1;	// second is either a :trim or a separator	if(nargs > n && args[n] != sl_trimsym){		delim = tostr(args[n]);		dlen = cv_len(ptr(args[n]));		n++;	}	bool trim = false;	// it can only be a :trim X now	if(nargs > n){		if(args[n] != sl_trimsym)			bthrow(lerrorf(sl_errarg, "invalid argument at position %d", n));		n++;		if(nargs <= n)			argcount(nargs, n+1);		trim = args[n] != sl_nil;	}	usize ssz, tokend, tokstart, i = 0;	sl_v first = sl_nil, c = sl_nil, last;	usize junk;	sl_gc_handle(&first);	sl_gc_handle(&last); 	do{		// find and allocate next token		tokstart = tokend = i;		while(i < len && !u8_memchr((u8int*)delim, u8_nextmemchar(s, &i), dlen, &junk))			tokend = i;		ssz = tokend - tokstart;		if(ssz == 0 && trim)			continue; 		last = c; // save previous cons cell		c = mk_cons(cvalue_str(ssz), sl_nil); 		if(delim != delim0){			// we've done allocation; reload movable pointers			s = cvalue_data(args[0]);			delim = cvalue_data(args[1]);		} 		if(ssz)			memmove(cvalue_data(car_(c)), &s[tokstart], ssz); 		// link new cell		if(last == sl_nil)			first = c;   // first time, save first cons		else			((sl_cons*)ptr(last))->cdr = c; 		// note this tricky condition: if the string ends with a		// delimiter, we need to go around one more time to add an		// empty string. this happens when (i == len && tokend < i)	}while(i < len || (i == len && tokend != i));	sl_free_gc_handles(2);	return first;} usizerune_index(sl_v str, usize runeidx){	char *s = tostr(str);	sl_cv *pcv = ptr(str);	usize startbytes, n;	if(!isinlined(pcv) && pcv->startrune <= runeidx){		startbytes = pcv->startbytes;		n = pcv->startrune;	}else{		startbytes = 0;		n = 0;	}	for(; n < runeidx && startbytes < pcv->len; n++)		startbytes += u8_seqlen(s+startbytes);	if(n != runeidx)		bthrow(bounds_error(str, fixnum(runeidx)));	if(!isinlined(pcv)){		pcv->startbytes = startbytes;		pcv->startrune = runeidx;	}	return startbytes;} BUILTIN("str-sub", str_sub){	if(nargs != 2)		argcount(nargs, 3);	char *s = tostr(args[0]);	usize lenbytes = cv_len(ptr(args[0])), n = tosize(args[1]);	usize startbytes = rune_index(args[0], n), endbytes = lenbytes;	if(nargs == 3 && args[2] != sl_nil){		usize endrune = tosize(args[2]);		for(endbytes = startbytes; n < endrune && endbytes < lenbytes; n++)			endbytes += u8_seqlen(s+endbytes);		if(n != endrune)			bthrow(bounds_error(args[0], args[2]));	}	sl_v ns = cvalue_str(endbytes-startbytes);	s = cvalue_data(args[0]); // reload after alloc	memmove(cvalue_data(ns), s+startbytes, endbytes-startbytes);	return ns;} BUILTIN("str-rune", str_rune){	argcount(nargs, 2);	usize startbytes = rune_index(args[0], tosize(args[1]));	if(startbytes >= cv_len(ptr(args[0])))		bthrow(bounds_error(args[0], args[1]));	char *s = tostr(args[0]);	Rune r;	chartorune(&r, s+startbytes);	return mk_rune(r);} sl_purefnBUILTIN("rune->codepoint", rune_2_codepoint){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return fixnum(torune(args[0]));} sl_purefnBUILTIN("rune-upcase", rune_upcase){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return mk_rune(toupperrune(torune(args[0])));} sl_purefnBUILTIN("rune-downcase", rune_downcase){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return mk_rune(tolowerrune(torune(args[0])));} sl_purefnBUILTIN("rune-titlecase", rune_titlecase){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return mk_rune(totitlerune(torune(args[0])));} sl_purefnBUILTIN("rune-alphabetic?", rune_alphabeticp){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return isalpharune(torune(args[0])) ? sl_t : sl_nil;} sl_purefnBUILTIN("rune-lower-case?", rune_lower_casep){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return islowerrune(torune(args[0])) ? sl_t : sl_nil;} sl_purefnBUILTIN("rune-upper-case?", rune_upper_casep){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return isupperrune(torune(args[0])) ? sl_t : sl_nil;} sl_purefnBUILTIN("rune-title-case?", rune_title_casep){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return istitlerune(torune(args[0])) ? sl_t : sl_nil;} sl_purefnBUILTIN("rune-numeric?", rune_numericp){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return isdigitrune(torune(args[0])) ? sl_t : sl_nil;} sl_purefnBUILTIN("rune-whitespace?", rune_whitespacep){	argcount(nargs, 1);	if(!isrune(args[0]))		bthrow(type_error(nil, "rune", args[0]));	return isspacerune(torune(args[0])) ? sl_t : sl_nil;} BUILTIN("str-find", str_find){	usize startrune = 0;	if(nargs == 3)		startrune = tosize(args[2]);	else		argcount(nargs, 2);	char *s = tostr(args[0]);	sl_cv *pcv = ptr(args[0]);	usize sbytes = pcv->len;	if(sbytes == 0)		return sl_nil; 	// needle	char *nd;	usize ndbytes;	sl_v v = args[1];	char rbuf[UTFmax+1];	if(isrune(v)){		Rune r = torune(v);		ndbytes = runetochar(rbuf, &r);		nd = rbuf;		nd[ndbytes] = 0;	}else if(isstr(v)){		sl_cv *cv = ptr(v);		ndbytes = cv_len(cv);		nd = (char*)cv_data(cv);	}else{		bthrow(type_error("needle", "(or str rune)", args[1]));	}	if(ndbytes == 0)		return size_wrap(startrune);	if(ndbytes > sbytes)		return sl_nil; 	usize i = rune_index(args[0], startrune), n;	// now search for the needle	for(n = startrune; i < sbytes-ndbytes+1; n++){		if(s[i] == nd[0] && memcmp(&s[i+1], nd+1, ndbytes-1) == 0)			return size_wrap(n);		i += u8_seqlen(s+i);	}	return sl_nil;} static intget_radix_arg(sl_v arg){	int radix = tosize(arg);	if(radix < 2 || radix > 36)		cthrow(lerrorf(sl_errarg, "invalid radix: %d", radix), arg);	return radix;} BUILTIN("str->num", str_2_num){	if(nargs < 1 || nargs > 2)		argcount(nargs, 2);	char *s = tostr(args[0]), *e;	sl_v n;	int base = 10;	if(nargs == 2 && args[1] != sl_nil)		base = get_radix_arg(args[1]);	else if(s[0] == '#'){		char c = tolower((u8int)s[1]);		if(((c == 'b' && (base = 2)) ||		    (c == 'o' && (base = 8)) ||		    (c == 'd' && (base = 10)) ||		    (c == 'x' && (base = 16))) &&		   (isdigit_base(s[2], base) || s[2] == '-')){			s += 2;		}else if(isdigit((u8int)s[1])){			int r = strtol(s+1, &e, 10);			if(*e == 'r' || *e == 'R'){				if(r < 2 || r > 36)					bthrow(lerrorf(sl_errarg, "invalid radix: %d", r));				base = r;				s = e+1;			}		}	}	if(!sl_read_numtok(s, &n, base))		return sl_nil;	return n;} sl_purefnBUILTIN("str-utf8?", str_utf8p){	argcount(nargs, 1);	char *s = tostr(args[0]);	usize len = cv_len(ptr(args[0]));	return u8_isvalid(s, len) ? sl_t : sl_nil;} voidstr_init(void){}