Error ends_with(Stack* S, Stack* scope_arr)
{
require(2);
V haystack = popS();
V needle = popS();
if (getType(needle) != T_STR || getType(haystack) != T_STR)
{
clear_ref(needle);
clear_ref(haystack);
return TypeError;
}
NewString *needle_s = toNewString(needle);
NewString *haystack_s = toNewString(haystack);
if (needle_s->size > haystack_s->size ||
memcmp(haystack_s->text + haystack_s->size - needle_s->size,
needle_s->text, needle_s->size))
{
pushS(add_ref(v_false));
}
else
{
pushS(add_ref(v_true));
}
clear_ref(needle);
clear_ref(haystack);
return Nothing;
}
Error concat_list(Stack *S, Stack *scope_arr) /* concat [ "a" "b" "c" ] */
{
NewString *s1;
int i;
require(1);
V v1 = popS();
if (getType(v1) == T_LIST)
{
int newlength = 0;
int u = toStack(v1)->used;
V *n = toStack(v1)->nodes;
for (i = u - 1; i >= 0; i--)
{
if (getType(n[i]) != T_STR)
{
clear_ref(v1);
return TypeError;
}
newlength += toNewString(n[i])->size;
}
char *new = malloc(newlength + 1);
char *currpoint = new;
for (i = u - 1; i >= 0; i--)
{
s1 = toNewString(n[i]);
memcpy(currpoint, s1->text, s1->size);
currpoint += s1->size;
}
*currpoint = '\0';
pushS(str_to_string(newlength, new));
clear_ref(v1);
return Nothing;
}
V load_file(V file_name, V global)
{
if (file_name == NULL || getType(file_name) != T_STR)
{
clear_ref(file_name);
return NULL;
}
FILE* f = fopen(toNewString(file_name)->text, "rb");
if (f == NULL)
{
clear_ref(file_name);
return NULL;
}
fseek(f, 0, SEEK_END);
size_t length = ftell(f);
rewind(f);
char *data = malloc(length * sizeof(char));
size_t read = fread(data, sizeof(char), length, f);
assert (read == length);
V new_file = load_memfile(data, length, file_name, global);
free(data);
fclose(f);
clear_ref(file_name);
return new_file;
}
char *make_persist_path(V fname)
{
NewString *s = toNewString(fname);
char *pathbase = getenv("XDG_DATA_HOME");
size_t plen;
char *home = NULL;
if (pathbase == NULL)
{
home = getenv("HOME");
plen = strlen(home) + strlen("/.local/share");
pathbase = malloc(plen + 1);
sprintf(pathbase, "%s/.local/share", home);
}
else
{
plen = strlen(pathbase);
}
char *data = malloc(plen + strlen("/deja/persist/") + s->size + 3 + 1);
sprintf(data, "%s/deja/persist/%*s.vu", pathbase, (int)s->size, s->text);
if (home)
{ // if home is not NULL, that means we allocated pathbase
free(pathbase);
}
makedirs(data);
return data;
}
V unichar_to_value(unichar c)
{
utf8 adr = NULL;
V r = empty_string_to_value(codepoint_length(c), &adr);
toNewString(r)->length = 1;
encode_codepoint(c, adr);
return r;
}
uint32_t need_hash(V string)
{
NewString *s = toNewString(string);
if (s->hash == 0)
{
s->hash = new_string_hash(s->size, s->text);
}
return s->hash;
}
Error count(Stack* S, Stack* scope_arr)
{
require(2);
V haystack = popS();
V needle = popS();
if (getType(haystack) != T_STR || getType(needle) != T_STR)
{
clear_ref(haystack);
clear_ref(needle);
return TypeError;
}
size_t haystack_len = toNewString(haystack)->size;
size_t needle_len = toNewString(needle)->size;
if (needle_len == 0)
{
pushS(int_to_value(string_length(toNewString(haystack)) + 1));
clear_ref(haystack);
clear_ref(needle);
return Nothing;
}
utf8 haystack_c = toNewString(haystack)->text;
utf8 needle_c = toNewString(needle)->text;
utf8index ix;
int count = 0;
for (ix = 0; ix < haystack_len - needle_len + 1; )
{
if (!memcmp(haystack_c + ix, needle_c, needle_len))
{
count++;
ix += needle_len;
}
else
{
ix = nextchar(haystack_c, ix);
}
}
pushS(int_to_value(count));
clear_ref(haystack);
clear_ref(needle);
return Nothing;
}
Error concat(Stack *S, Stack *scope_arr) /* concat( "a" "b" "c" ) */
{
NewString *s1;
int i;
require(1);
V v1 = popS();
int newlength = 0;
for (i = S->used - 1; i >= 0; i--)
{
int t = getType(S->nodes[i]);
if (t == T_IDENT && S->nodes[i] == get_ident(")"))
{
break;
}
else if (t != T_STR)
{
clear_ref(v1);
return TypeError;
}
newlength += toNewString(S->nodes[i])->size;
}
char *new = malloc(newlength + 1);
char *currpoint = new;
for (i = S->used - 1; i >= 0; i--)
{
if (getType(S->nodes[i]) == T_IDENT && S->nodes[i] == get_ident(")"))
{
clear_ref(popS());
break;
}
s1 = toNewString(S->nodes[i]);
memcpy(currpoint, s1->text, s1->size);
currpoint += s1->size;
clear_ref(popS());
}
*currpoint = '\0';
pushS(str_to_string(newlength, new));
clear_ref(v1);
return Nothing;
}
V a_to_string(char* str)
{
size_t size = strlen(str);
V t = make_new_value(T_STR, true, sizeof(NewString) + size);
NewString *s = toNewString(t);
s->size = size;
s->hash = 0;
s->length = -1;
memcpy(s->text, str, size + 1);
return t;
}
V empty_string_to_value(size_t max, utf8 *adr)
{
V t = make_new_value(T_STR, true, sizeof(NewString) + max);
NewString *s = toNewString(t);
s->size = max;
s->hash = 0;
s->length = -1;
s->text[max] = '\0';
*adr = s->text;
return t;
}
V str_to_string(size_t max, char *str)
{
V t = make_new_value(T_STR, true, sizeof(NewString) + max);
NewString *s = toNewString(t);
s->size = max;
s->hash = 0;
s->length = -1;
memcpy(s->text, str, max);
s->text[max] = '\0';
return t;
}
Error chars(Stack* S, Stack* scope_arr)
{
require(1);
V source = popS();
if (getType(source) != T_STR)
{
clear_ref(source);
return TypeError;
}
utf8 chrs = toNewString(source)->text;
utf8index index = 0;
V list = new_list();
Stack *st = toStack(list);
size_t size = toNewString(source)->size;
size_t i;
for (i = 0; i < size; i++)
{
push(st, unichar_to_value(decode_codepoint(chrs, &index)));
}
pushS(list);
return Nothing;
}
Error find(Stack* S, Stack* scope_arr)
{
require(2);
V haystack = popS();
V needle = popS();
if (getType(needle) != T_STR || getType(haystack) != T_STR)
{
clear_ref(needle);
clear_ref(haystack);
return TypeError;
}
NewString *needle_s = toNewString(needle);
NewString *haystack_s = toNewString(haystack);
if (string_length(needle_s) <= string_length(haystack_s))
{
size_t haystack_len = haystack_s->size;
size_t needle_len = needle_s->size;
utf8 haystack_c = haystack_s->text;
utf8 needle_c = needle_s->text;
utf8index ix;
int i = 0;
for (ix = 0; ix < haystack_len - needle_len + 1; ix = nextchar(haystack_c, ix))
{
if (!memcmp(haystack_c + ix, needle_c, needle_len))
{
pushS(int_to_value(i));
clear_ref(needle);
clear_ref(haystack);
return Nothing;
}
i++;
}
}
pushS(int_to_value(-1));
clear_ref(needle);
clear_ref(haystack);
return Nothing;
}
Error contains(Stack* S, Stack* scope_arr)
{
require(2);
V haystack = popS();
V needle = popS();
if (getType(needle) != T_STR || getType(haystack) != T_STR)
{
clear_ref(needle);
clear_ref(haystack);
return TypeError;
}
NewString *needle_s = toNewString(needle);
NewString *haystack_s = toNewString(haystack);
if (string_length(needle_s) > string_length(haystack_s))
{
pushS(add_ref(v_false));
}
else
{
uint32_t i;
utf8index index = 0;
for (i = 0; i <= string_length(haystack_s) - string_length(needle_s); i++)
{
if (!memcmp(haystack_s->text + index, needle_s->text, needle_s->size))
{
pushS(add_ref(v_true));
clear_ref(needle);
clear_ref(haystack);
return Nothing;
}
index = nextchar(haystack_s->text, index);
}
pushS(add_ref(v_false));
}
clear_ref(needle);
clear_ref(haystack);
return Nothing;
}
Error ord(Stack* S, Stack* scope_arr)
{
require(1);
V v = popS();
if (getType(v) != T_STR)
{
clear_ref(v);
return TypeError;
}
NewString *s = toNewString(v);
if (s->size == 0)
{
clear_ref(v);
return ValueError;
}
utf8index n = 0;
pushS(int_to_value(decode_codepoint(s->text, &n)));
clear_ref(v);
return Nothing;
}
void write_object(FILE *file, V obj, HashMap *hm)
{
int t = getType(obj);
union double_or_uint64_t num;
ITreeNode *id = NULL;
NewString *s = NULL;
Stack *st;
HashMap *hmv;
int8_t n8;
uint8_t l8;
int32_t n32;
uint32_t l32;
int64_t n64;
uint64_t l64;
int i;
Bucket *b;
char type = t;
switch (t)
{
case T_NUM:
if (canBeSmallInt(obj))
type |= TYPE_SHORT;
break;
case T_IDENT:
id = toIdent(obj);
if (id->length < 256)
type |= TYPE_SHORT;
break;
case T_STR:
s = toNewString(obj);
if (s->size < 256)
type |= TYPE_SHORT;
break;
case T_FRAC:
if (toNumerator(obj) < 128 && toNumerator(obj) >= -128 &&
toDenominator(obj) < 256)
type |= TYPE_SHORT;
break;
}
fwrite(&type, 1, 1, file);
switch (t)
{
case T_IDENT:
if (type & TYPE_SHORT)
{
l8 = id->length;
fwrite(&l8, 1, 1, file);
}
else
{
l32 = id->length;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
}
fwrite(&id->data, id->length, 1, file);
break;
case T_STR:
if (type & TYPE_SHORT)
{
l8 = s->size;
fwrite(&l8, 1, 1, file);
}
else
{
l32 = s->size;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
}
fwrite(s->text, s->size, 1, file);
break;
case T_NUM:
if (type & TYPE_SHORT)
{
n32 = toInt(obj);
n32 = htonl(n32);
fwrite(((char*)&n32) + 1, 3, 1, file);
}
else
{
num.d = toNumber(obj);
num.i = htonll(num.i);
fwrite(&num, 8, 1, file);
}
break;
case T_FRAC:
if (type & TYPE_SHORT)
{
n8 = toNumerator(obj);
fwrite(&n8, 1, 1, file);
l8 = toDenominator(obj);
fwrite(&l8, 1, 1, file);
}
else
{
n64 = toNumerator(obj);
n64 = htonl(n64);
fwrite(&n64, 8, 1, file);
l64 = toDenominator(obj);
l64 = htonl(l64);
fwrite(&l64, 8, 1, file);
}
break;
case T_PAIR:
write_ref(file, toFirst(obj), hm);
write_ref(file, toSecond(obj), hm);
break;
case T_LIST:
st = toStack(obj);
l32 = st->used;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
for (i = 0; i < st->used; i++)
{
write_ref(file, st->nodes[i], hm);
}
break;
case T_DICT:
hmv = toHashMap(obj);
l32 = hmv->used;
l32 = htonl(l32);
fwrite(&l32, 4, 1, file);
if (hmv->map != NULL)
{
for (i = 0; i < hmv->size; i++)
{
b = hmv->map[i];
while(b != NULL)
{
write_ref(file, b->key, hm);
write_ref(file, b->value, hm);
b = b->next;
}
}
}
break;
}
}