reimplementation (oupsi)

old/wscm.h

@@ -0,0 +1,166 @@
+#include <stddef.h>
+#include <stdint.h>
+
+// common types
+typedef void V;
+
+typedef uintptr_t U;
+typedef intptr_t I;
+
+typedef uint8_t U8;
+typedef uint32_t U32;
+typedef int32_t I32;
+typedef size_t Z;
+
+// objects
+typedef uintptr_t O;
+
+// cons pair
+typedef struct C C;
+struct C {
+  O car, cdr;
+};
+
+// lambda
+typedef struct L L;
+struct L {
+  O args, body, env;
+};
+
+// symbol
+typedef struct S S;
+struct S {
+  U8 *data;
+  U32 hash;
+  Z len;
+};
+
+// symbol table
+typedef struct St St;
+struct St {
+  I count;
+  Z capacity;
+  S **data;
+};
+
+#define TYPE_MASK 7
+
+enum {
+  TAG_GC = 0,   // GC-managed object
+  TAG_NUM = 1,  // Immediate number
+  TAG_SYM = 2,  // Pointer to symbol
+  TAG_PRIM = 4, // Pointer to primitive
+};
+
+enum {
+  KIND_NIL = 0,
+  KIND_NUM = 1,
+  KIND_SYM = 2,
+  KIND_PRIM = 4,
+  KIND_CONS = 5,
+  KIND_CLOS = 6,
+  KIND__MAX,
+};
+
+#define TYPE(x) (((U)(x)) & TYPE_MASK)
+#define UNTAG(x) (((U)(x)) & ~TYPE_MASK)
+#define TAG(x, t) (void *)(((U)(x)) | t)
+
+enum { OBJ_CONS = 5, OBJ_CLOS = 6, OBJ_FWD = 7 };
+
+// gc header
+typedef struct H H;
+struct H {
+  I type;
+  Z size;
+};
+
+// heap
+typedef struct E E;
+struct E {
+  struct {
+    U8 *start, *end;
+    U8 *free;
+  } from, to;
+
+  I root_count;
+  Z root_capacity;
+  O **roots;
+};
+
+// primitive
+typedef struct P P;
+struct P {
+  const char *name;
+  O (*fn)(O, O);
+};
+
+extern E heap;
+extern St syms;
+
+#define ALIGN(n) (((n) + 7) & ~7)
+#define INFROM(x)                                                              \
+  (((const U8 *)x) >= heap.from.start && ((const U8 *)x) < heap.from.end)
+
+#define IMM(x) ((x) & 1)
+#define NUM(x) (((O)((I)(x) << 1)) | (O)1)
+#define ORD(x) ((I)(x) >> 1)
+#define BOX(x) ((O)(x))
+#define UNBOX(x) ((H *)(x))
+
+#define SYM(s) BOX(TAG(intern(s, -1), TAG_SYM))
+
+#define NIL ((O)0)
+#define GC_HEAP_BYTES (1024 * 1024)
+
+// GC
+void addroot(O *ptr);
+I rootmark(void);
+void rootreset(I mark);
+void collect(void);
+H *alloc(Z sz);
+void gcinit(void);
+void gcfinalize(void);
+
+I kind(O obj);
+const char *kindname(I k);
+
+S *intern(const char *str, I len);
+O mksym(const char *str);
+
+O cons(O head, O tail);
+C *uncons(O obj);
+
+O listreverse(O list);
+
+V setupenv(O *env);
+O eval(O obj, O env);
+
+void print(O obj);
+void println(O obj);
+
+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;
+
+int nexttoken(Lx *lex);
+O readfile(FILE *f);
+O readstring(const char *s);