Reader

src/base.h

@@ -0,0 +1,181 @@
+#ifndef INCLUDED_TYPES_H
+#define INCLUDED_TYPES_H
+
+#include "gc.h"
+#include "memory.h"
+
+#include <assert.h>
+
+// ###################
+// # Base value type #
+// ###################
+typedef void LispVal;
+
+// ##########################
+// # Fixnum and float stuff #
+// ##########################
+typedef intptr_t fixnum_t;
+#if LISP_WORD_BITS == 32
+#    define LISP_FLOAT_SCANF "f"
+typedef lisp_float32_t lisp_float_t;
+#else
+#    define LISP_FLOAT_SCANF "lf"
+typedef lisp_float64_t lisp_float_t;
+#endif
+
+#define MOST_POSITIVE_FIXNUM ((intptr_t) ((INTPTR_MAX & ~(intptr_t) 3) >> 2))
+#define MOST_NEGATIVE_FIXNUM ((intptr_t) ((INTPTR_MIN & ~(intptr_t) 3) >> 2))
+
+static ALWAYS_INLINE uintptr_t EXTRACT_TAG(LispVal *val) {
+    uintptr_t iv = (uintptr_t) val;
+    return iv & (uintptr_t) 3;
+}
+
+#define LISP_TAG_BITS   2
+#define LISP_OBJECT_TAG ((uintptr_t) 0)
+// 0b01
+#define FIXNUM_TAG ((uintptr_t) 1)
+// 0b11
+#define LISP_FLOAT_TAG ((uintptr_t) 3)
+
+static ALWAYS_INLINE bool LISP_OBJECT_P(LispVal *val) {
+    return EXTRACT_TAG(val) == LISP_OBJECT_TAG;
+}
+
+static ALWAYS_INLINE bool FIXNUMP(LispVal *val) {
+    return EXTRACT_TAG(val) == FIXNUM_TAG;
+}
+
+static ALWAYS_INLINE fixnum_t XFIXNUM(LispVal *val) {
+    assert(FIXNUMP(val));
+    return ((fixnum_t) val) >> 2;
+}
+
+static ALWAYS_INLINE LispVal *MAKE_FIXNUM(fixnum_t fn) {
+    return (LispVal *) ((fn << 2) | FIXNUM_TAG);
+}
+
+static ALWAYS_INLINE bool LISP_FLOAT_P(LispVal *val) {
+    return EXTRACT_TAG(val) == LISP_FLOAT_TAG;
+}
+
+static ALWAYS_INLINE lisp_float_t XLISP_FLOAT(LispVal *val) {
+    assert(LISP_FLOAT_P(val));
+    uintptr_t iv = (uintptr_t) val;
+    iv &= ~(uintptr_t) 3;
+    return INT_TO_FLOAT_BITS(iv);
+}
+
+static ALWAYS_INLINE LispVal *MAKE_LISP_FLOAT(lisp_float_t flt) {
+    uintptr_t bits = FLOAT_TO_INT_BITS(flt);
+    return (LispVal *) ((bits & ~(uintptr_t) 3) | LISP_FLOAT_TAG);
+}
+
+// ###############
+// # Other types #
+// ###############
+typedef enum {
+    TYPE_FIXNUM,
+    TYPE_FLOAT,
+    TYPE_CONS,
+    TYPE_STRING,
+    TYPE_SYMBOL,
+    TYPE_VECTOR,
+    TYPE_HASH_TABLE,
+    TYPE_FUNCTION,
+    N_LISP_TYPES,
+} LispValType;
+extern const char *LISP_TYPE_NAMES[N_LISP_TYPES];
+
+#define LISP_OBJECT_ALIGNMENT (1 << LISP_TAG_BITS)
+void *lisp_alloc_object(size_t size, LispValType type);
+
+typedef struct {
+    LispValType type;
+    ObjectGCInfo gc;
+} LispObject;
+
+static ALWAYS_INLINE LispValType TYPE_OF(LispVal *val) {
+    if (FIXNUMP(val)) {
+        return TYPE_FIXNUM;
+    } else if (LISP_FLOAT_P(val)) {
+        return TYPE_FLOAT;
+    } else {
+        return ((LispObject *) val)->type;
+    }
+}
+
+static ALWAYS_INLINE bool LISP_TYPEP(LispVal *val, LispValType type) {
+    if (FIXNUMP(val)) {
+        return type == TYPE_FIXNUM;
+    } else if (LISP_FLOAT_P(val)) {
+        return type == TYPE_FLOAT;
+    } else {
+        return ((LispObject *) val)->type == type;
+    }
+}
+
+#define DEFOBJTYPE(Name, NAME, NAME_P, body)         \
+    typedef struct {                                 \
+        LispObject header;                           \
+        struct body;                                 \
+    } Lisp##Name;                                    \
+    static ALWAYS_INLINE bool NAME_P(LispVal *val) { \
+        return LISP_TYPEP(val, TYPE_##NAME);         \
+    }                                                \
+    struct __ignored
+
+DEFOBJTYPE(String, STRING, STRINGP, {
+    size_t length;
+    char *data;
+    bool owned;
+});
+
+DEFOBJTYPE(Symbol, SYMBOL, SYMBOLP, {
+    LispVal *name; // string
+    LispVal *function;
+    LispVal *value;
+    LispVal *plist;
+});
+
+DEFOBJTYPE(Vector, VECTOR, VECTORP, {
+    size_t length;
+    LispVal **data;
+});
+
+#define DECLARE_SYMBOL(cname)           \
+    extern const char *Q##cname##_name; \
+    extern LispVal *Q##cname
+
+#define DECLARE_FUNCTION(cname, cargs) \
+    DECLARE_SYMBOL(cname);             \
+    extern const char F##cname_name;   \
+    LispVal *F##cname cargs
+
+#define DEFINE_SYMBOL(cname, lisp_name)      \
+    const char *Q##cname##_name = lisp_name; \
+    LispVal *Q##cname
+
+#define DEFUN(cname, lisp_name, cargs, lisp_args, doc) \
+    DEFINE_SYMBOL(cname, lisp_name);                   \
+    LispVal *Q##cname;                                 \
+    LispVal *F##cname cargs
+
+DECLARE_SYMBOL(nil);
+DECLARE_SYMBOL(t);
+DECLARE_SYMBOL(unbound);
+
+static ALWAYS_INLINE bool NILP(LispVal *val) {
+    return val == Qnil;
+}
+
+// TODO probably move these to another file
+LispVal *make_lisp_string(const char *data, size_t length, bool take,
+                          bool copy);
+LispVal *make_vector(LispVal **data, size_t length, bool take);
+#define LISP_LITSTR(litstr) \
+    (make_lisp_string(litstr, sizeof(litstr) - 1, false, false))
+DECLARE_FUNCTION(make_symbol, (LispVal * name));
+DECLARE_FUNCTION(intern, (LispVal * name));
+
+#endif