Zander671/simple-lisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-06-28 16:47:23 +09:00
commit 5b6bd50f45
10 changed files with 2007 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

326
src/lisp.h Normal file
View File

@ -0,0 +1,326 @@
#ifndef INCLUDED_LISP_H
#define INCLUDED_LISP_H
#include <stdarg.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#if __has_attribute(format)
# define PRINTF_FORMAT(first, second) \
__attribute__((format(printf, first, second)))
#else
# define PRINTF_FORMAT(first, second)
#endif
typedef enum {
TYPE_NULL = 0,
TYPE_STRING,
TYPE_SYMBOL,
TYPE_PAIR,
TYPE_INTEGER,
TYPE_FLOAT,
TYPE_VECTOR,
TYPE_FUNCTION,
TYPE_HASHTABLE,
N_LISP_TYPES,
} LispType;
struct _TypeNameEntry {
const char *name;
size_t len;
};
extern struct _TypeNameEntry LISP_TYPE_NAMES[N_LISP_TYPES];
#define OBJ_TYPE_NAME(obj) (LISP_TYPE_NAMES[LISPVAL(obj)->type].name)
#define LISP_OBJECT_HEADER \
LispType type; \
ptrdiff_t ref_count;
typedef struct {
LISP_OBJECT_HEADER;
} LispVal;
#define LISPVAL(obj) ((LispVal *) (obj))
#define STATICP(v) (LISPVAL(v)->ref_count < 0)
#define TYPEOF(v) (LISPVAL(v)->type)
typedef struct {
LISP_OBJECT_HEADER;
char *data;
size_t length;
bool is_static;
} LispString;
typedef struct {
LISP_OBJECT_HEADER;
LispString *name;
LispVal *plist;
LispVal *function;
LispVal *value;
} LispSymbol;
typedef struct {
LISP_OBJECT_HEADER;
LispVal *head;
LispVal *tail;
} LispPair;
typedef struct {
LISP_OBJECT_HEADER;
intmax_t value;
} LispInteger;
typedef struct {
LISP_OBJECT_HEADER;
long double value;
} LispFloat;
typedef struct {
LISP_OBJECT_HEADER;
LispVal **data;
size_t length;
} LispVector;
typedef LispVal *(*lisp_builtin_t)();
typedef struct {
LISP_OBJECT_HEADER;
LispVal *doc;
LispVal *args;
bool is_builtin;
union {
LispVal *body;
lisp_builtin_t builtin;
};
} LispFunction;
struct HashtableBucket {
struct HashtableBucket *next;
uint64_t hash;
LispVal *key;
LispVal *value;
};
#define LISP_HASHTABLE_INITIAL_SIZE 32
#define LISP_HASHTABLE_GROWTH_FACTOR 2
#define LISP_HASHTABLE_GROWTH_THRESHOLD 0.75f
#define LISP_HASHTABLE_SHRINK_THRESHOLD 0.25f
typedef struct {
LISP_OBJECT_HEADER;
struct HashtableBucket **data;
size_t table_size;
size_t count;
LispVal *eq_fn;
LispVal *hash_fn;
} LispHashtable;
#define NILP(v) (TYPEOF(v) == TYPE_NULL)
#define STRINGP(v) (TYPEOF(v) == TYPE_STRING)
#define SYMBOLP(v) (TYPEOF(v) == TYPE_SYMBOL)
#define PAIRP(v) (TYPEOF(v) == TYPE_PAIR)
#define INTEGERP(v) (TYPEOF(v) == TYPE_INTEGER)
#define FLOATP(v) (TYPEOF(v) == TYPE_FLOAT)
#define VECTORP(v) (TYPEOF(v) == TYPE_VECTOR)
#define FUNCTIONP(v) (TYPEOF(v) == TYPE_FUNCTION)
#define HASHTABLEP(v) (TYPEOF(v) == TYPE_HASHTABLE)
#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)
inline static bool LISTP(LispVal *v) {
return NILP(v) || PAIRP(v);
}
inline static bool NUMBERP(LispVal *v) {
return INTEGERP(v) || FLOATP(v);
}
extern LispVal _Qnil;
extern LispSymbol _Qunbound;
extern LispSymbol _Qt;
#define Qnil (&_Qnil)
#define Qunbound (LISPVAL(&_Qunbound))
#define Qt (LISPVAL(&_Qt))
extern LispVal *Qquote;
extern LispVal *Qbackquote;
extern LispVal *Qcomma;
#define LISP_BOOL(v) ((v) ? Qt : Qnil)
#define DEF_STATIC_STRING(name, value) \
static LispString name = { \
.type = TYPE_STRING, \
.ref_count = -1, \
.data = value, \
.length = sizeof(value) - 1, \
.is_static = true, \
};
#define DEF_STATIC_SYMBOL(c_name, lisp_name) \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.function = Qunbound, \
.value = Qunbound, \
}; \
LispVal *Q##c_name = LISPVAL(&_Q##c_name);
void *lisp_malloc(size_t size);
void *lisp_realloc(void *old_ptr, size_t size);
#define lisp_free free
char *lisp_strdup(const char *str);
inline static void *lisp_ref(void *val) {
if (!STATICP(val)) {
++((LispVal *) val)->ref_count;
}
return val;
}
inline static void *lisp_float_ref(void *val) {
if (LISPVAL(val)->ref_count > 0) {
--LISPVAL(val)->ref_count;
}
return val;
}
void _internal_lisp_delete_object(LispVal *val);
inline static void *lisp_unref(void *val) {
if (STATICP(val)) {
return val;
} else if (LISPVAL(val)->ref_count > 1) {
--LISPVAL(val)->ref_count;
return val;
} else {
_internal_lisp_delete_object(val);
return Qnil;
}
}
#define UNREF_INPLACE(variable) \
{ \
variable = lisp_unref(variable); \
}
LispVal *make_lisp_string(const char *data, size_t length, bool take,
bool is_static);
#define STATIC_STRING(s) (make_lisp_string((s), sizeof(s) - 1, true, true))
LispVal *sprintf_lisp(const char *format, ...) PRINTF_FORMAT(1, 2);
LispVal *make_lisp_symbol(LispVal *name);
LispVal *make_lisp_pair(LispVal *head, LispVal *tail);
LispVal *make_lisp_integer(intmax_t value);
LispVal *make_lisp_float(long double value);
LispVal *make_lisp_vector(LispVal **data, size_t length);
// TODO make_lisp_function
LispVal *make_lisp_hashtable(LispVal *eq_fn, LispVal *hash_fn);
#define DECLARE_FUNCTION(c_name, args) \
extern LispVal *Q##c_name; \
LispVal *F##c_name args;
// The args and doc fields are filled when the function is registered
#define DEFUN(c_name, lisp_name, c_args) \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispFunction _Q##c_name##_function = { \
.type = TYPE_FUNCTION, \
.ref_count = -1, \
.doc = Qnil, \
.args = Qnil, \
.is_builtin = true, \
.builtin = &F##c_name, \
}; \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.function = LISPVAL(&_Q##c_name##_function), \
}; \
LispVal *Q##c_name = (LispVal *) &_Q##c_name; \
LispVal *F##c_name c_args
DECLARE_FUNCTION(type_of, (LispVal * obj));
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
DECLARE_FUNCTION(hash_string, (LispVal * obj));
DECLARE_FUNCTION(strings_equal, (LispVal * obj1, LispVal *obj2));
bool strings_equal_nocase(const char *s1, const char *s2, size_t n);
DECLARE_FUNCTION(id, (LispVal * obj));
DECLARE_FUNCTION(eq, (LispVal * obj1, LispVal *obj2));
DECLARE_FUNCTION(puthash, (LispVal * table, LispVal *key, LispVal *value));
DECLARE_FUNCTION(gethash, (LispVal * table, LispVal *key, LispVal *def));
DECLARE_FUNCTION(remhash, (LispVal * table, LispVal *key));
DECLARE_FUNCTION(hash_table_count, (LispVal * table));
#define HASHTABLE_FOREACH(key_var, val_var, table, body) \
{ \
LispHashtable *__hashtable_foreach_table = (LispHashtable *) table; \
for (size_t __hashtable_foreach_i = 0; \
__hashtable_foreach_i < __hashtable_foreach_table->count; \
++__hashtable_foreach_i) { \
struct HashtableBucket *__hashtable_foreach_cur = \
__hashtable_foreach_table->data[__hashtable_foreach_i]; \
while (__hashtable_foreach_cur) { \
LispVal *key_var = __hashtable_foreach_cur->key; \
LispVal *val_var = __hashtable_foreach_cur->value; \
{body}; \
__hashtable_foreach_cur = __hashtable_foreach_cur->next; \
} \
} \
}
DECLARE_FUNCTION(intern, (LispVal * name));
LispVal *intern(const char *name, size_t length, bool take);
#define INTERN_STATIC(name) (Fintern(STATIC_STRING(name)))
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
static inline LispVal *make_list(int len, ...) {
LispVal *list = Qnil;
LispVal *end;
va_list args;
va_start(args, len);
while (len--) {
LispVal *elt = va_arg(args, LispVal *);
if (NILP(list)) {
list = Fpair(elt, Qnil);
end = list;
} else {
LispVal *new_end = Fpair(elt, Qnil);
Fsettail(end, new_end);
end = new_end;
}
}
va_end(args);
return list;
}
DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
extern LispVal *Qtype_error;
extern LispVal *Qread_error;
#define CHECK_TYPE(type, val) \
if (TYPEOF(val) != type) { \
Fthrow(Qtype_error, Qnil); \
return Qnil; \
}
extern LispVal *Vobarray;
void lisp_init(void);
void lisp_shutdown(void);
void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);
#endif