factor/native/string.c

#include "factor.h"

/* untagged */
F_STRING* allot_string(CELL capacity)
{
	F_STRING* string = allot_object(STRING_TYPE,
		sizeof(F_STRING) + capacity * CHARS);
	string->capacity = capacity;
	return string;
}

/* call this after constructing a string */
/* uses same algorithm as java.lang.String for compatibility with
images generated from Java Factor. */
F_FIXNUM hash_string(F_STRING* str, CELL len)
{
	F_FIXNUM hash = 0;
	CELL i;
	for(i = 0; i < len; i++)
		hash = 31*hash + string_nth(str,i);
	return hash;
}

void rehash_string(F_STRING* str)
{
	str->hashcode = tag_fixnum(hash_string(str,str->capacity));
}

/* untagged */
F_STRING* string(CELL capacity, CELL fill)
{
	CELL i;

	F_STRING* string = allot_string(capacity);

	for(i = 0; i < capacity; i++)
		cput(SREF(string,i),fill);

	rehash_string(string);

	return string;
}

F_STRING* grow_string(F_STRING* string, F_FIXNUM capacity, uint16_t fill)
{
	/* later on, do an optimization: if end of array is here, just grow */
	CELL i;

	F_STRING* new_string = allot_string(capacity);

	memcpy(new_string + 1,string + 1,string->capacity * CHARS);

	for(i = string->capacity; i < capacity; i++)
		cput(SREF(new_string,i),fill);

	return new_string;
}

INLINE F_STRING* memory_to_string(const BYTE* string, CELL length)
{
	F_STRING* s = allot_string(length);
	CELL i;

	for(i = 0; i < length; i++)
	{
		cput(SREF(s,i),*string);
		string++;
	}

	rehash_string(s);
	
	return s;
}

void primitive_memory_to_string(void)
{
	CELL length = unbox_cell();
	BYTE* string = (BYTE*)unbox_cell();
	dpush(tag_object(memory_to_string(string,length)));
}

/* untagged */
F_STRING* from_c_string(const BYTE* c_string)
{
	return memory_to_string(c_string,strlen(c_string));
}

/* FFI calls this */
void box_c_string(const BYTE* c_string)
{
	dpush(tag_object(from_c_string(c_string)));
}

/* untagged */
BYTE* to_c_string(F_STRING* s)
{
	CELL i;

	for(i = 0; i < s->capacity; i++)
	{
		uint16_t ch = string_nth(s,i);
		if(ch == '\0' || ch > 255)
			general_error(ERROR_C_STRING,tag_object(s));
	}

	return to_c_string_unchecked(s);
}

INLINE void string_to_memory(F_STRING* s, BYTE* string)
{
	CELL i;
	for(i = 0; i < s->capacity; i++)
		string[i] = string_nth(s,i);
}

void primitive_string_to_memory(void)
{
	BYTE* address = (BYTE*)unbox_cell();
	F_STRING* str = untag_string(dpop());
	string_to_memory(str,address);
}

/* untagged */
BYTE* to_c_string_unchecked(F_STRING* s)
{
	F_STRING* _c_str = allot_string(s->capacity / CHARS + 1);
	BYTE* c_str = (BYTE*)(_c_str + 1);
	string_to_memory(s,c_str);
	c_str[s->capacity] = '\0';
	return c_str;
}

/* FFI calls this */
BYTE* unbox_c_string(void)
{
	return to_c_string(untag_string(dpop()));
}

/* FFI calls this */
uint16_t* unbox_utf16_string(void)
{
	/* Return pointer to first character */
	return (uint16_t*)(untag_string(dpop()) + 1);
}

void primitive_string_nth(void)
{
	F_STRING* string = untag_string(dpop());
	CELL index = to_fixnum(dpop());

	if(index < 0 || index >= string->capacity)
		range_error(tag_object(string),0,tag_fixnum(index),string->capacity);
	dpush(tag_fixnum(string_nth(string,index)));
}

F_FIXNUM string_compare_head(F_STRING* s1, F_STRING* s2, CELL len)
{
	CELL i = 0;
	while(i < len)
	{
		uint16_t c1 = string_nth(s1,i);
		uint16_t c2 = string_nth(s2,i);
		if(c1 != c2)
			return c1 - c2;
		i++;
	}
	
	return 0;
}

F_FIXNUM string_compare(F_STRING* s1, F_STRING* s2)
{
	CELL len1 = s1->capacity;
	CELL len2 = s2->capacity;

	CELL limit = (len1 < len2 ? len1 : len2);

	CELL comp = string_compare_head(s1,s2,limit);
	if(comp != 0)
		return comp;
	else
		return len1 - len2;
}

void primitive_string_compare(void)
{
	F_STRING* s2 = untag_string(dpop());
	F_STRING* s1 = untag_string(dpop());

	dpush(tag_fixnum(string_compare(s1,s2)));
}

void primitive_string_eq(void)
{
	F_STRING* s1 = untag_string(dpop());
	CELL with = dpop();
	if(type_of(with) == STRING_TYPE)
	{
		F_STRING* s2 = (F_STRING*)UNTAG(with);
		if(s1->hashcode != s2->hashcode)
			dpush(F);
		else if(s1 == s2)
			dpush(T);
		else
			dpush(tag_boolean((string_compare(s1,s2) == 0)));
	}
	else
		dpush(F);
}

CELL index_of_ch(CELL index, F_STRING* string, CELL ch)
{
	while(index < string->capacity)
	{
		if(string_nth(string,index) == ch)
			return index;
		index++;
	}

	return -1;
}

INLINE F_FIXNUM index_of_str(F_FIXNUM index, F_STRING* string, F_STRING* substring)
{
	CELL i = index;
	CELL limit = string->capacity - substring->capacity;
	CELL scan;

	if(substring->capacity == 1)
		return index_of_ch(index,string,string_nth(substring,0));

	if(substring->capacity > string->capacity)
		return -1;

outer:	if(i <= limit)
	{
		for(scan = 0; scan < substring->capacity; scan++)
		{
			if(string_nth(string,i + scan)
				!= string_nth(substring,scan))
			{
				i++;
				goto outer;
			}
		}

		/* We reached here and every char in the substring matched */
		return i;
	}

	/* We reached here and nothing matched */
	return -1;
}

/* index string substring -- index */
void primitive_index_of(void)
{
	CELL ch = dpop();
	F_STRING* string;
	F_FIXNUM index;
	CELL result;
	string = untag_string(dpop());
	index = to_fixnum(dpop());
	if(index < 0 || index > string->capacity)
	{
		range_error(tag_object(string),0,tag_fixnum(index),string->capacity);
		result = -1; /* can't happen */
	}
	else if(TAG(ch) == FIXNUM_TYPE)
		result = index_of_ch(index,string,to_fixnum(ch));
	else
		result = index_of_str(index,string,untag_string(ch));
	dpush(tag_fixnum(result));
}

INLINE F_STRING* substring(CELL start, CELL end, F_STRING* string)
{
	F_STRING* result;

	if(start < 0)
		range_error(tag_object(string),0,tag_fixnum(start),string->capacity);

	if(end < start || end > string->capacity)
		range_error(tag_object(string),0,tag_fixnum(end),string->capacity);

	result = allot_string(end - start);
	memcpy(result + 1,
		(void*)((CELL)(string + 1) + CHARS * start),
		CHARS * (end - start));
	rehash_string(result);

	return result;
}

/* start end string -- string */
void primitive_substring(void)
{
	F_STRING* string;
	CELL end, start;

	maybe_garbage_collection();

	string = untag_string(dpop());
	end = to_fixnum(dpop());
	start = to_fixnum(dpop());
	dpush(tag_object(substring(start,end,string)));
}

/* DESTRUCTIVE - don't use with user-visible strings */
void string_reverse(F_STRING* s, int len)
{
	int i, j;
	uint16_t ch1, ch2;
	for(i = 0; i < len / 2; i++)
	{
		j = len - i - 1;
		ch1 = string_nth(s,i);
		ch2 = string_nth(s,j);
		set_string_nth(s,j,ch1);
		set_string_nth(s,i,ch2);
	}
}

/* Doesn't rehash the string! */
F_STRING* string_clone(F_STRING* s, int len)
{
	F_STRING* copy = allot_string(len);
	memcpy(copy + 1,s + 1,len * CHARS);
	return copy;
}

void primitive_string_reverse(void)
{
	F_STRING* s;

	maybe_garbage_collection();

	s = untag_string(dpeek());
	s = string_clone(s,s->capacity);
	string_reverse(s,s->capacity);
	rehash_string(s);
	drepl(tag_object(s));
}

void primitive_to_string(void)
{
	type_check(STRING_TYPE,dpeek());
}