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

Basic evaluation, exceptions, and the stack

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-06-30 23:29:02 +09:00
parent 5b6bd50f45
commit 40f717277d
3 changed files with 646 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

161
src/lisp.h
View File

@ -1,12 +1,14 @@
#ifndef INCLUDED_LISP_H
#define INCLUDED_LISP_H
#include <setjmp.h>
#include <stdarg.h>
#include <stdbool.h>
#include <stddef.h>
#include <stdint.h>
#include <stdio.h>
#include <stdlib.h>
#include <stdnoreturn.h>
#if __has_attribute(format)
# define PRINTF_FORMAT(first, second) \
@ -16,7 +18,6 @@
#endif
typedef enum {
TYPE_NULL = 0,
TYPE_STRING,
TYPE_SYMBOL,
TYPE_PAIR,
@ -61,6 +62,7 @@ typedef struct {
LispVal *plist;
LispVal *function;
LispVal *value;
bool is_constant;
} LispSymbol;
typedef struct {
@ -73,7 +75,7 @@ typedef struct {
typedef struct {
LISP_OBJECT_HEADER;
intmax_t value;
int64_t value;
} LispInteger;
typedef struct {
@ -89,18 +91,25 @@ typedef struct {
size_t length;
} LispVector;
typedef LispVal *(*lisp_builtin_t)();
typedef struct {
LISP_OBJECT_HEADER;
LispVal *doc;
LispVal *args;
bool is_builtin;
bool is_macro;
size_t n_req;
size_t n_opt;
size_t n_kw;
LispVal **kwargs;
bool has_rest;
union {
void *builtin;
LispVal *body;
lisp_builtin_t builtin;
};
LispVal *lexenv;
} LispFunction;
struct HashtableBucket {
@ -125,7 +134,7 @@ typedef struct {
LispVal *hash_fn;
} LispHashtable;
#define NILP(v) (TYPEOF(v) == TYPE_NULL)
#define NILP(v) (((void *) (v)) == (void *) Qnil)
#define STRINGP(v) (TYPEOF(v) == TYPE_STRING)
#define SYMBOLP(v) (TYPEOF(v) == TYPE_SYMBOL)
#define PAIRP(v) (TYPEOF(v) == TYPE_PAIR)
@ -137,6 +146,14 @@ typedef struct {
#define ATOM(v) (TYPEOF(v) != TYPE_PAIR)
extern LispSymbol _Qnil;
extern LispSymbol _Qunbound;
extern LispSymbol _Qt;
#define Qnil (LISPVAL(&_Qnil))
#define Qunbound (LISPVAL(&_Qunbound))
#define Qt (LISPVAL(&_Qt))
inline static bool LISTP(LispVal *v) {
return NILP(v) || PAIRP(v);
}
@ -145,15 +162,6 @@ 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;
@ -176,13 +184,13 @@ extern LispVal *Qcomma;
.plist = Qnil, \
.function = Qunbound, \
.value = Qunbound, \
.is_constant = false, \
}; \
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)) {
@ -214,6 +222,10 @@ inline static void *lisp_unref(void *val) {
{ \
variable = lisp_unref(variable); \
}
inline static void lisp_unref_double_ptr(void **val) {
lisp_unref(*val);
}
#define IGNORE_REF(val) (lisp_unref(lisp_ref(val)))
LispVal *make_lisp_string(const char *data, size_t length, bool take,
bool is_static);
@ -228,29 +240,36 @@ LispVal *make_lisp_vector(LispVal **data, size_t length);
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;
LispVal *F##c_name args; \
extern LispVal *Q##c_name;
// 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; \
#define _INTERNAL_DEFUN_EXTENDED(macrop, c_name, lisp_name, c_args) \
LispVal *F##c_name c_args; \
DEF_STATIC_STRING(_Q##c_name##_name, lisp_name); \
static LispFunction _Q##c_name##_function = { \
.type = TYPE_FUNCTION, \
.ref_count = -1, \
.is_builtin = true, \
.is_macro = macrop, \
.builtin = &F##c_name, \
.lexenv = Qnil, \
}; \
static LispSymbol _Q##c_name = { \
.type = TYPE_SYMBOL, \
.ref_count = -1, \
.name = &_Q##c_name##_name, \
.plist = Qnil, \
.value = Qunbound, \
.function = LISPVAL(&_Q##c_name##_function), \
.is_constant = false, \
}; \
LispVal *Q##c_name = (LispVal *) &_Q##c_name; \
LispVal *F##c_name c_args
#define DEFUN(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(false, c_name, lisp_name, c_args)
#define DEFMACRO(c_name, lisp_name, c_args) \
_INTERNAL_DEFUN_EXTENDED(true, c_name, lisp_name, c_args)
DECLARE_FUNCTION(type_of, (LispVal * obj));
DECLARE_FUNCTION(pair, (LispVal * head, LispVal *tail));
@ -285,6 +304,7 @@ LispVal *intern(const char *name, size_t length, bool take);
DECLARE_FUNCTION(sethead, (LispVal * pair, LispVal *head));
DECLARE_FUNCTION(settail, (LispVal * pair, LispVal *tail));
size_t list_length(LispVal *obj);
static inline LispVal *make_list(int len, ...) {
LispVal *list = Qnil;
LispVal *end;
@ -304,22 +324,87 @@ static inline LispVal *make_list(int len, ...) {
va_end(args);
return list;
}
#define FOREACH(var, list) \
for (LispVal *__foreach_cur = list, *var = Fhead(list); \
!NILP(__foreach_cur); \
__foreach_cur = Ftail(__foreach_cur), var = Fhead(__foreach_cur))
DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
typedef void (*lisp_cleanup_func_t)(void *);
struct CleanupHandlerEntry {
struct CleanupHandlerEntry *next;
lisp_cleanup_func_t fun;
void *data;
};
typedef struct StackFrame {
struct StackFrame *next;
bool hidden;
LispSymbol *name;
LispVal *detail; // function arguments
LispVal *lexenv; // symbol -> value
bool enable_handlers;
LispVal *handlers; // symbol -> (error-var form)
LispVal *unwind_forms;
struct CleanupHandlerEntry *cleanup_handlers;
jmp_buf start;
} StackFrame;
extern StackFrame *the_stack;
extern LispVal *Qtoplevel;
extern LispVal *Qparent_lexenv;
void stack_enter(LispVal *name, LispVal *detail, bool inherit);
void stack_leave(void);
void *register_cleanup(lisp_cleanup_func_t fun, void *data);
void cancel_cleanup(void *handle);
#define WITH_PUSH_FRAME(name, detail, inherit, body) \
stack_enter(name, detail, inherit); \
if (setjmp(the_stack->start) == 0) { \
body \
} \
stack_leave();
#define WITH_CLEANUP(var, body) \
lisp_ref(var); \
{ \
void *__with_cleanup_cleanup = register_cleanup( \
(lisp_cleanup_func_t) & lisp_unref_double_ptr, &(var)); \
{body}; \
cancel_cleanup(__with_cleanup_cleanup); \
lisp_unref(var); \
}
DECLARE_FUNCTION(backtrace, ());
noreturn DECLARE_FUNCTION(throw, (LispVal * signal, LispVal *rest));
extern LispVal *Qshutdown_signal;
extern LispVal *Qtype_error;
extern LispVal *Qread_error;
extern LispVal *Qvoid_variable_error;
extern LispVal *Qvoid_function_error;
extern LispVal *Qcircular_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);
DECLARE_FUNCTION(quote, (LispVal * form));
DECLARE_FUNCTION(symbol_function, (LispVal * symbol, LispVal *resolve));
DECLARE_FUNCTION(symbol_value, (LispVal * symbol));
DECLARE_FUNCTION(eval_in_env, (LispVal * form, LispVal *lexenv));
DECLARE_FUNCTION(eval, (LispVal * form));
DECLARE_FUNCTION(funcall, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(apply, (LispVal * function, LispVal *rest));
DECLARE_FUNCTION(head, (LispVal * list));
DECLARE_FUNCTION(tail, (LispVal * list));
noreturn DECLARE_FUNCTION(exit, (LispVal * code));
void debug_dump(FILE *stream, void *obj, bool newline);
void debug_print_hashtable(FILE *stream, LispVal *table);