#ifndef WOLFLISP_H #define WOLFLISP_H #include #include #include /// * Behavioral macros #define GC_DEBUG 1 /// * Type declarations typedef void V; typedef intptr_t I; typedef uintptr_t U; typedef char C; typedef uint8_t U8; typedef uint16_t U16; typedef uint32_t U32; typedef int32_t I32; typedef size_t Z; // Object typedef U O; #define NIL ((O)0) #define IMM(x) ((O)(x) & (O)1) #define NUM(x) (((O)((I)(x) << 1)) | (O)1) #define ORD(x) ((I)(x) >> 1) // Cons pair typedef struct Pa { O head, tail; } Pa; // Symbol typedef struct Sy { U32 hash; Z len; char *data; } Sy; typedef struct Ss { Z len; char *data; } Ss; // Closure typedef struct Cl { O args, body, env; } Cl; // Bytecode typedef struct Bc { Z len; U8 *data; Z constant_count; O *constants; } Bc; // Primitive typedef struct In In; typedef struct Pr { const char *name; O (*fn)(In *, O *, int, O); // fn(interp, args_array, argc, env) int min_args; // Minimum number of arguments (-1 for no check) int max_args; // Maximum number of arguments (-1 for variadic) } Pr; // Symbol table typedef struct St { Z count; Z capacity; Sy **data; } St; #define HEAP_BYTES (4 * 1024 * 1024) #define TYPE_MASK 7 enum { TAG_MAN = 0, // GC-managed object TAG_IMM = 1, // Immediate number TAG_SYM = 2, // Pointer to symbol TAG_PRIM = 4, // Pointer to primitive }; enum { TYPE_NIL = 0, TYPE_NUM = 1, // These three are the same as their tags. TYPE_SYM = 2, TYPE_PRIM = 4, TYPE_PAIR, TYPE_STR, TYPE_CLOS, TYPE_MAC, TYPE_CODE, TYPE_FWD, TYPE__MAX, }; #define TAG_OF(x) (((U)(x)) & TYPE_MASK) #define UNTAG(x) (((U)(x)) & ~TYPE_MASK) #define TAG(x, t) (V *)(((U)(x)) | t) // GC-managed header typedef struct Gh { U32 type; U32 size; } Gh; #define BOX(x) ((O)(x)) #define UNBOX(x) ((Gh *)(x)) // GC space typedef struct Gs { U8 *start, *end; U8 *free; } Gs; // GC context typedef struct Gc { Gs from, to; struct { Z count; Z capacity; O **data; } roots; } Gc; // Error context typedef struct Er { jmp_buf handler; int active; char message[512]; struct { const char *frames[32]; int count; } stack; } Er; // Call frame typedef struct Fr { U8 *ip; O env; } Fr; #define VM_STACK_SIZE 4096 // Interpreter context typedef struct In { Gc gc; St symtab; O env; Er err; O t; // the T symbol O stack[VM_STACK_SIZE]; O *sp; } In; // Opcodes enum { OP_HALT, OP_CONST, OP_GET, OP_SET, OP_JUMP, OP_JUMP_IF_NIL, OP_CALL, OP_RET, OP_POP, OP_CLOS, OP_TAIL_CALL, OP_BIND, OP_BIND_REST, OP_PEEK, OP_GET_LOCAL, // Get local variable from stack frame OP_SET_LOCAL, // Set local variable in stack frame OP_RESERVE, // Reserve space for local variables }; // Local variable info typedef struct Lv { O name; // Symbol name U16 index; // Stack slot index int captured; // Is this variable captured by a closure? } Lv; // Compiler context typedef struct Cm { In *in; U8 *code; Z count; Z capacity; struct { O *data; Z count; Z capacity; } constants; struct { O quote; O iff; O fn; O progn; O def; } specials; struct { Lv *data; Z count; Z capacity; } locals; int use_stack_locals; // Use stack-based locals instead of env } Cm; enum { TOK_EOF = 0, TOK_COMMENT = ';', TOK_WORD = 'a', TOK_LPAREN = '(', TOK_RPAREN = ')', TOK_STRING = '"', TOK_QUOTE = '\'', TOK_DOT = '.', }; #include #define LEXER_CAP 1024 typedef struct Lx { int kind; int cursor; FILE *input; char buffer[1024]; } Lx; /// * Function declarations // Get the type of an object I type(O obj); // Get the name of a type const char *typename(I t); // Add a root to a GC context. V gc_addroot(Gc *gc, O *root); // Mark the current root state in a GC context. I gc_rootmark(Gc *gc); // Reset the root state in a GC context to a previously marked state. V gc_rootreset(Gc *gc, I mark); // Perform a garbage collection in a GC context. V gc_collect(Gc *gc); // Allocate memory in a GC context. Gh *gc_alloc(Gc *gc, Z sz); // Initialize a GC context. V gc_init(Gc *gc); // Finalize a GC context. V gc_finalize(Gc *gc); void error_init(Er *err); void error_throw(In *in, const char *fmt, ...); void error_print(In *in); // Initialize an interpreter context. V interp_init(In *in); // Finalize an interpreter context. V interp_finalize(In *in); // Intern a string Sy *intern(St *tab, const char *str, Z len); // Create a pair O pair_make(In *in, O head, O tail); // Unwrap a pair Pa *pair_unwrap(In *in, O obj); O string_make(In *in, const char *cstr, I len); V print(O obj); V println(O obj); O symbol_make(In *in, const char *str); O prim_make(In *in, const char *name, O (*fn)(In *, O *, int, O), int min_args, int max_args); O list_assoc(In *in, O key, O alist); O list_reverse(In *in, O list); O list_next(In *in, O *list); V compile(Cm *co, O expr, I toplevel); V disassemble(Cm *co); O vm_run(Cm *c); int nexttoken(Lx *lex); #endif