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 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)

// Pair
typedef struct Pa {
  O head, tail;
} Pa;

// Symbol
typedef struct Sy {
  U32 hash;
  Z len;
  U8 *data;
} Sy;

// Closure
typedef struct Cl {
  O args, body, env;
} Cl;

// Primitive
typedef struct In In;
typedef struct Pr {
  const char *name;
  O (*fn)(In *, O, O);
} Pr;

// Symbol table
typedef struct St {
  Z count;
  Z capacity;
  Sy **data;
} St;

#define HEAP_BYTES (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_CLOS,
  TYPE_MAC,
  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;

// Interpreter context
typedef struct In {
  Gc gc;
  St symtab;
  O env;
  Er err;
  O t; // the T symbol
} In;

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_push_frame(In *in, const char *frame);
void error_pop_frame(In *in);
void error_print(In *in);

// Initialize an interpreter context.
V interp_init(In *in);
// Finalize an interpreter context.
V interp_finalize(In *in);

// Evaluate a list of values.
O interp_eval_list(In *in, O list, O env);

// Evaluate an expression.
O interp_eval(In *in, O obj, O env);

// 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(O obj);

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, O));

O list_assoc(O key, O alist);
O list_reverse(O list);

int nexttoken(Lx *lex);

#endif