76 lines
2.1 KiB
C
76 lines
2.1 KiB
C
#include "lisp_string.h"
|
|
|
|
#include <stdarg.h>
|
|
#include <stdio.h>
|
|
#include <string.h>
|
|
|
|
LispVal *make_lisp_string(const char *data, size_t length, bool take,
|
|
bool copy) {
|
|
LispString *obj = lisp_alloc_object(sizeof(LispString), TYPE_STRING);
|
|
obj->owned = take;
|
|
obj->length = length;
|
|
if (copy) {
|
|
obj->data = lisp_malloc(length + 1);
|
|
memcpy(obj->data, data, length);
|
|
obj->data[length] = '\0';
|
|
} else {
|
|
obj->data = (char *) data;
|
|
}
|
|
return obj;
|
|
}
|
|
|
|
LispVal *lisp_sprintf(const char *format, ...) {
|
|
va_list args;
|
|
va_start(args, format);
|
|
LispVal *s = lisp_vsprintf(format, args);
|
|
va_end(args);
|
|
return s;
|
|
}
|
|
|
|
LispVal *lisp_vsprintf(const char *format, va_list args) {
|
|
va_list args2;
|
|
va_copy(args2, args);
|
|
int needed = vsnprintf(NULL, 0, format, args2);
|
|
va_end(args2);
|
|
char *buffer = lisp_malloc(needed + 1);
|
|
int printed = vsnprintf(buffer, needed + 1, format, args);
|
|
assert(printed == needed);
|
|
return make_lisp_string(buffer, printed, true, false);
|
|
}
|
|
|
|
DEFUN(strings_equal, "strings-equal", (LispVal * string1, LispVal *string2),
|
|
"(string1 string2)", "") {
|
|
CHECK_TYPE(string1, TYPE_STRING);
|
|
CHECK_TYPE(string2, TYPE_STRING);
|
|
if (((LispString *) string1)->length != ((LispString *) string2)->length) {
|
|
return Qnil;
|
|
}
|
|
return memcmp(((LispString *) string1)->data,
|
|
((LispString *) string2)->data,
|
|
((LispString *) string1)->length)
|
|
== 0
|
|
? Qt
|
|
: Qnil;
|
|
}
|
|
|
|
DEFUN(hash_string, "hash-string", (LispVal * string), "(string)", "") {
|
|
CHECK_TYPE(string, TYPE_STRING);
|
|
size_t len = ((LispString *) string)->length;
|
|
const char *str = ((LispString *) string)->data;
|
|
uintptr_t hash = 5381;
|
|
for (size_t i = 0; i < len; ++i) {
|
|
hash = ((hash << 5) + hash) + str[i];
|
|
}
|
|
return MAKE_FIXNUM(hash);
|
|
}
|
|
|
|
DEFUN(charp, "charp", (LispVal * obj), "(obj)", "") {
|
|
if (!FIXNUMP(obj)) {
|
|
return Qnil;
|
|
}
|
|
fixnum_t val = XFIXNUM(obj);
|
|
return (val >= 0 && val <= 255) ? Qt : Qnil;
|
|
}
|
|
|
|
DEFINE_SYMBOL(char, "char");
|