wl/include/wolflisp.h

#ifndef WOLFLISP_H
#define WOLFLISP_H

#include <setjmp.h>
#include <stddef.h>
#include <stdint.h>

/// * 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);
  int min_args;
  int max_args;
} 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_TAIL_CALL,
  OP_RET,
  OP_POP,
  OP_CLOS,
  OP_MAC,
  OP_BIND,
  OP_BIND_REST,
  OP_PEEK,
  OP_GET_LOCAL,
  OP_SET_LOCAL,
  OP_RESERVE,
  OP_DUP,
};

// Local variable info
typedef struct Lv {
  O name;
  U16 index;
  I escapes;
} Lv;

// Compiler context
typedef struct Cm Cm;
struct Cm {
  Cm *parent;
  In *in;
  U8 *code;
  Z count;
  Z capacity;
  struct {
    O *data;
    Z count;
    Z capacity;
  } constants;
  struct {
    O quote;
    O iff;
    O fn;
    O mac;
    O progn;
    O def;
    O and;
    O or;
  } specials;
  struct {
    Lv *data;
    Z count;
    Z capacity;
  } locals;
  I use_locals;
};

enum {
  TOK_EOF = 0,
  TOK_COMMENT = ';',
  TOK_WORD = 'a',
  TOK_LPAREN = '(',
  TOK_RPAREN = ')',
  TOK_STRING = '"',
  TOK_QUOTE = '\'',
  TOK_DOT = '.',
};

#include <stdio.h>

#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