Fix gc bug and add condition classes

src/base.c

@@ -140,6 +140,51 @@ DEFUN(symbol_function, "symbol-function", (LispVal * sym, LispVal *resolve),
     return sym;
 }
 
+DEFUN(symbol_plist, "symbol-plist", (LispVal * sym), "(sym)", "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    return ((LispSymbol *) sym)->plist;
+}
+
+DEFUN(setplist, "setplist", (LispVal * sym, LispVal *plist), "(sym plist)",
+      "") {
+    CHECK_TYPE(sym, TYPE_SYMBOL);
+    return ((LispSymbol *) sym)->plist = plist;
+}
+
+DEFUN(get, "get", (LispVal * sym, LispVal *key, LispVal *def),
+      "(sym key &optional def)", "") {
+    return Fplist_get(Fsymbol_plist(sym), key, def);
+}
+
+DEFUN(put, "put", (LispVal * sym, LispVal *key, LispVal *val), "(sym key val)",
+      "") {
+    return Fsetplist(sym, Fplist_put(Fsymbol_plist(sym), key, val));
+}
+
+DEFINE_SYMBOL(condition_class, "condition-class");
+
+DEFUN(condition_class_p, "condition-class-p", (LispVal * val), "(val)", "") {
+    if (!SYMBOLP(val)) {
+        return Qnil;
+    }
+    LispVal *class = Fget(val, Qcondition_class, Qnil);
+    return !NILP(class) && SYMBOLP(class) ? class : Qnil;
+}
+
+DEFUN(condition_subclass_p, "condition-subclass-p",
+      (LispVal * child, LispVal *parent), "(child parent)", "") {
+    if (parent == child || (parent == Qt && SYMBOLP(child))) {
+        return Qt;
+    }
+    LispVal *cur = child;
+    while (!NILP((cur = Fcondition_class_p(cur))) && cur != Qt) {
+        if (cur == parent) {
+            return Qt;
+        }
+    }
+    return Qnil;
+}
+
 DEFINE_SYMBOL(backquote, "`");
 DEFINE_SYMBOL(comma, ",");
 DEFINE_SYMBOL(comma_at, ",@");