Work on dynamic variable

src/base.h

@@ -162,7 +162,6 @@ static ALWAYS_INLINE void internal_CHECK_TYPE(LispVal *obj, size_t count,
     // Failed
     internal_CHECK_TYPE_signal_type_error(obj, count, types);
 }
-#define internal_CHECK_TYPE1(obj, type) internal_CHECK_TYPE(obj, v1, )
 #define internal_CHECK_TYPE_SUB(obj, count, a1, a2, a3, a4, a5, a6, ...) \
     internal_CHECK_TYPE((obj), count, a1, a2, a3, a4, a5, a6)
 #define CHECK_TYPE(obj, ...)                                             \
@@ -188,10 +187,26 @@ DEFOBJTYPE(String, STRING, STRINGP, {
     bool owned;
 });
 
+enum SymbolValueType {
+    SYMBOL_NORMAL,
+    SYMBOL_NATIVE,
+};
+
+enum SymbolFlags {
+    SYMBOL_DYNAMIC = 1,
+    SYMBOL_CONST_VALUE = 2,
+    SYMBOL_CONST_FUNCTION = 4,
+};
+
 DEFOBJTYPE(Symbol, SYMBOL, SYMBOLP, {
     LispVal *name; // string
+    enum SymbolValueType value_type : 1;
+    enum SymbolFlags flags : 7;
     LispVal *function;
-    LispVal *value;
+    union {
+        LispVal *normal;
+        LispVal **native;
+    } value;
     LispVal *plist;
 });
 
@@ -215,6 +230,11 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
     extern const size_t internal_Q##cname##_name_len; \
     extern LispVal *Q##cname
 
+#define DECLARE_VARIABLE(cname)                     \
+    DECLARE_SYMBOL(cname);                          \
+    extern LispVal *internal_V##cname##_init(void); \
+    extern LispVal *V##cname
+
 #define DECLARE_FUNCTION(cname, cargs)                  \
     DECLARE_SYMBOL(cname);                              \
     extern const char *internal_F##cname##_argstr;      \
@@ -228,6 +248,13 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
     const size_t internal_Q##cname##_name_len = sizeof(lisp_name) - 1; \
     LispVal *Q##cname
 
+#define DEFVAR(cname, lisp_name, doc, init_val) \
+    DEFINE_SYMBOL(cname, lisp_name);            \
+    LispVal *internal_V##cname##_init(void) {   \
+        return (init_val);                      \
+    }                                           \
+    LispVal *V##cname
+
 #define DEFUN(cname, lisp_name, cargs, lisp_args, doc)                   \
     DEFINE_SYMBOL(cname, lisp_name);                                     \
     const char *internal_F##cname##_argstr = lisp_args;                  \
@@ -244,8 +271,17 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
         Q##cname = Fintern(make_lisp_string(internal_Q##cname##_name,     \
                                             internal_Q##cname##_name_len, \
                                             false, false));               \
+        ((LispSymbol *) Q##cname)->value_type = SYMBOL_NORMAL;            \
         lisp_gc_register_static_object(Q##cname);                         \
     }
+#define REGISTER_GLOBAL_VARIABLE(cname)                        \
+    REGISTER_GLOBAL_SYMBOL(cname);                             \
+    {                                                          \
+        V##cname = internal_V##cname##_init();                 \
+        ((LispSymbol *) Q##cname)->value_type = SYMBOL_NATIVE; \
+        ((LispSymbol *) Q##cname)->value.native = &V##cname;   \
+        ((LispSymbol *) Q##cname)->flags |= SYMBOL_DYNAMIC;    \
+    }
 #define REGISTER_GLOBAL_FUNCTION(cname)                                    \
     {                                                                      \
         REGISTER_GLOBAL_SYMBOL(cname);                                     \
@@ -263,7 +299,7 @@ DEFOBJTYPE(Vector, VECTOR, VECTORP, {
 DECLARE_SYMBOL(nil);
 DECLARE_SYMBOL(t);
 DECLARE_SYMBOL(unbound);
-DECLARE_SYMBOL(lexical_environment);
+DECLARE_VARIABLE(lexical_environment);
 
 extern LispVal *Vlexical_environment;
 
@@ -295,12 +331,45 @@ DECLARE_FUNCTION(put, (LispVal * sym, LispVal *key, LispVal *val));
 
 static ALWAYS_INLINE LispVal *SYMBOL_VALUE(LispVal *sym) {
     assert(SYMBOLP(sym));
-    return ((LispSymbol *) sym)->value;
+    LispSymbol *s = (LispSymbol *) sym;
+    switch (s->value_type) {
+    case SYMBOL_NORMAL:
+        return s->value.normal;
+    case SYMBOL_NATIVE:
+        return *s->value.native;
+    }
+}
+
+static ALWAYS_INLINE bool CONST_VALUE_P(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    return ((LispSymbol *) sym)->flags & SYMBOL_CONST_VALUE;
+}
+
+static ALWAYS_INLINE bool CONST_FUNCTION_P(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    return ((LispSymbol *) sym)->flags & SYMBOL_CONST_FUNCTION;
+}
+
+static ALWAYS_INLINE bool DYNAMIC_SYMBOL_P(LispVal *sym) {
+    assert(SYMBOLP(sym));
+    return ((LispSymbol *) sym)->flags & SYMBOL_DYNAMIC;
 }
 
 static ALWAYS_INLINE void SET_SYMBOL_VALUE(LispVal *sym, LispVal *value) {
     assert(SYMBOLP(sym));
-    ((LispSymbol *) sym)->value = value;
+    LispSymbol *s = (LispSymbol *) sym;
+    if (CONST_VALUE_P(sym)) {
+        // TODO throw
+        abort();
+    }
+    switch (s->value_type) {
+    case SYMBOL_NORMAL:
+        s->value.normal = value;
+        break;
+    case SYMBOL_NATIVE:
+        *s->value.native = value;
+        break;
+    }
 }
 
 // condition stuff