Work on dynamic variable

2026-07-19 02:23:10 -07:00
parent 67b68f8c61
commit f87af5efd2
11 changed files with 285 additions and 112 deletions
@@ -0,0 +1,122 @@
+#include "print.h"
+
+#include "lisp.h"
+
+DEFVAR(print_circular, "print-circular", "", Qt);
+DEFVAR(print_length, "print-length", "", MAKE_FIXNUM(100));
+DEFVAR(print_level, "print-level", "", Qnil);
+
+struct PrintContext {
+    bool circle;
+    bool length;
+};
+
+static void init_print_context(struct PrintContext *restrict pc) {
+    pc->circle = true;
+    pc->length = 80;
+}
+
+static void print_driver(struct PrintContext *restrict pc, LispVal *val) {
+    switch (TYPE_OF(val)) {
+    case TYPE_FIXNUM:
+    case TYPE_FLOAT:
+    case TYPE_CONS:
+    case TYPE_STRING:
+    case TYPE_SYMBOL:
+    case TYPE_VECTOR:
+    case TYPE_HASH_TABLE:
+    case TYPE_FUNCTION:
+        break;
+    default:
+        abort();
+    }
+}
+
+DEFUN(princ, "princ", (LispVal * val), "(val)", "") {
+    struct PrintContext pc;
+    init_print_context(&pc);
+    print_driver(&pc, val);
+    return Qnil;
+}
+
+DEFUN(prin1, "prin1", (LispVal * val), "(val)", "") {
+    struct PrintContext pc;
+    init_print_context(&pc);
+    print_driver(&pc, val);
+    return Qnil;
+}
+
+void debug_print(FILE *file, LispVal *obj) {
+    switch (TYPE_OF(obj)) {
+    case TYPE_FIXNUM:
+        fprintf(file, "%jd", (intmax_t) XFIXNUM(obj));
+        break;
+    case TYPE_FLOAT:
+        fprintf(file, "%f", (double) XLISP_FLOAT(obj));
+        break;
+    case TYPE_STRING: {
+        LispString *s = obj;
+        fputc('"', file);
+        fwrite(s->data, 1, s->length, file);
+        fputc('"', file);
+        break;
+    }
+    case TYPE_SYMBOL: {
+        LispString *name = ((LispSymbol *) obj)->name;
+        fwrite(name->data, 1, name->length, file);
+        break;
+    }
+    case TYPE_HASH_TABLE: {
+        fprintf(file, "<hash-table count=%zu at 0x%jx>",
+                ((LispHashTable *) obj)->count, (uintmax_t) obj);
+        break;
+    }
+    case TYPE_FUNCTION: {
+        LispFunction *fobj = obj;
+        if (NILP(fobj->name)) {
+            fprintf(file, "<lambda at 0x%jx>", (uintmax_t) obj);
+        } else {
+            fprintf(file, "<function ");
+            debug_print(file, fobj->name);
+            fprintf(file, " at 0x%jx>", (uintmax_t) obj);
+        }
+        break;
+    }
+    case TYPE_CONS: {
+        fputc('(', file);
+        DOTAILS(tail, obj) {
+            if (CONSP(tail)) {
+                debug_print(file, XCAR(tail));
+                if (!NILP(XCDR(tail))) {
+                    fputc(' ', file);
+                }
+            } else {
+                fwrite(". ", 1, 2, file);
+                debug_print(file, tail);
+            }
+        }
+        fputc(')', file);
+        break;
+    }
+    case TYPE_VECTOR: {
+        LispVector *v = obj;
+        fputc('[', file);
+        for (size_t i = 0; i < v->length; ++i) {
+            debug_print(file, v->data[i]);
+            if (i < v->length - 1) {
+                fputc(' ', file);
+            }
+        }
+        fputc(']', file);
+        break;
+    }
+    default:
+        abort();
+    }
+}
+
+void debug_obj_info(FILE *file, LispVal *obj) {
+    fprintf(file, "%s -> ", LISP_TYPE_NAMES[TYPE_OF(obj)]);
+    debug_print(file, obj);
+    fputc('\n', file);
+}