Zander671/glisp
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Work on dynamic variable

Browse Source
This commit is contained in:
Alexander Rosenberg
2026-07-19 02:23:10 -07:00
parent 67b68f8c61
commit f87af5efd2
11 changed files with 285 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
lisp/kernel.gl
+8 -1
View File
@@ -1,3 +1,10 @@
;; -*- mode: lisp-data -*-
(test a)
(fset 'test (lambda () (print print-circular)))
(print print-circular)
(let ((print-circular nil))
(test))
(print print-circular)
src/base.c
+9 -5
View File
@@ -74,9 +74,7 @@ noreturn void signal_type_error(LispVal *obj, LispVal *typespec) {
DEFINE_SYMBOL(nil, "nil");
DEFINE_SYMBOL(t, "t");
DEFINE_SYMBOL(unbound, "unbound");
DEFINE_SYMBOL(lexical_environment, "lexical-environment");
LispVal *Vlexical_environment;
DEFVAR(lexical_environment, "lexical-environment", "", Qnil);
DEFUN(id, "id", (LispVal * obj), "(id)", "") {
// TODO not all values are handled here
@@ -112,10 +110,12 @@ DEFUN(make_symbol, "make-symbol", (LispVal * name), "(name)",
obj->name = name;
obj->function = Qnil;
obj->plist = Qnil;
obj->value_type = SYMBOL_NORMAL;
if (KEYWORDP(obj)) {
obj->value = obj;
obj->value.normal = obj;
obj->flags |= SYMBOL_CONST_VALUE;
} else {
obj->value = Qunbound;
obj->value.normal = Qunbound;
}
return obj;
}
@@ -161,6 +161,10 @@ DEFUN(set, "set", (LispVal * sym, LispVal *value), "(sym value)", "") {
DEFUN(fset, "fset", (LispVal * sym, LispVal *value), "(sym value)", "") {
CHECK_TYPE(sym, TYPE_SYMBOL);
if (CONST_FUNCTION_P(sym)) {
// TODO throw
abort();
}
((LispSymbol *) sym)->function = value;
return value;
}
src/base.h
+74 -5
View File
@@ -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
src/gc.c
+1 -1
View File
@@ -206,7 +206,7 @@ static void mark_object(LispVal *val) {
case TYPE_SYMBOL: {
LispSymbol *sym = val;
make_grey_if_white(sym->name);
make_grey_if_white(sym->value);
make_grey_if_white(SYMBOL_VALUE(sym));
make_grey_if_white(sym->function);
make_grey_if_white(sym->plist);
break;
src/gen-init-globals.awk
+5
View File
@@ -91,6 +91,11 @@ function maybe_emit_next_symbol(entity) {
maybe_emit_next_symbol("SYMBOL")
}
/DEFVAR\(/ {
maybe_print_file_header()
maybe_emit_next_symbol("VARIABLE")
}
END {
print "}"
}
src/lisp.c
+7 -79
View File
@@ -10,18 +10,21 @@ static void construct_manual_symbols(void) {
// IMPORTANT: the symbols listed here need to also be set as special in
// gen-init-globals.awk
Qnil = Fmake_symbol(LISP_LITSTR("nil"));
((LispSymbol *) Qnil)->value = Qnil;
((LispSymbol *) Qnil)->flags = SYMBOL_CONST_VALUE | SYMBOL_CONST_FUNCTION;
((LispSymbol *) Qnil)->value.normal = Qnil;
((LispSymbol *) Qnil)->function = Qnil;
((LispSymbol *) Qnil)->plist = Qnil;
lisp_gc_register_static_object(Qnil);
Qt = Fmake_symbol(LISP_LITSTR("t"));
((LispSymbol *) Qt)->value = Qt;
((LispSymbol *) Qt)->flags = SYMBOL_CONST_VALUE | SYMBOL_CONST_FUNCTION;
((LispSymbol *) Qt)->value.normal = Qt;
lisp_gc_register_static_object(Qt);
Qunbound = Fmake_symbol(LISP_LITSTR("unbound"));
((LispSymbol *) Qunbound)->value = Qunbound;
((LispSymbol *) Qunbound)->value.normal = Qunbound;
lisp_gc_register_static_object(Qunbound);
Qlexical_environment = Fmake_symbol(LISP_LITSTR("lexical-environment"));
((LispSymbol *) Qlexical_environment)->value = Qnil;
((LispSymbol *) Qlexical_environment)->value_type = SYMBOL_NATIVE;
((LispSymbol *) Qlexical_environment)->value.native = &Vlexical_environment;
lisp_gc_register_static_object(Qlexical_environment);
Qhash_string = Fmake_symbol(LISP_LITSTR("hash-string"));
@@ -184,78 +187,3 @@ DEFSPECIAL(or, "or", (LispVal * forms), "(&rest forms)", "") {
DEFUN(null, "null", (LispVal * datum), "(datum)", "") {
return NILP(datum) ? Qt : 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);
}
src/lisp.h
+1 -8
View File
@@ -6,10 +6,9 @@
#include "hashtable.h" // IWYU pragma: export
#include "lisp_string.h" // IWYU pragma: export
#include "list.h" // IWYU pragma: export
#include "print.h" // IWYU pragma: export
#include "stack.h" // IWYU pragma: export
#include <stdio.h>
extern LispVal *obarray;
void lisp_init(void);
@@ -24,10 +23,4 @@ DECLARE_FUNCTION(and, (LispVal * forms));
DECLARE_FUNCTION(or, (LispVal * forms));
DECLARE_FUNCTION(null, (LispVal * datum));
__attribute__((no_sanitize("address"))) void debug_print(FILE *file,
LispVal *obj);
__attribute__((no_sanitize("address"))) void debug_obj_info(FILE *file,
LispVal *obj);
#endif
src/print.c
+122
View File
@@ -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);
}
src/print.h
+23
View File
@@ -0,0 +1,23 @@
#ifndef INCLUDED_PRINT_H
#define INCLUDED_PRINT_H
#include "base.h"
#include <stdio.h>
DECLARE_VARIABLE(print_circular);
DECLARE_VARIABLE(print_length);
DECLARE_VARIABLE(print_level);
// Pretty print
DECLARE_FUNCTION(princ, (LispVal * val));
// Quoted print
DECLARE_FUNCTION(prin1, (LispVal * val));
__attribute__((no_sanitize("address"))) void debug_print(FILE *file,
LispVal *obj);
__attribute__((no_sanitize("address"))) void debug_obj_info(FILE *file,
LispVal *obj);
#endif
src/stack.c
+34 -10
View File
@@ -131,10 +131,13 @@ static void store_local_reference_in_frame(StackFrame *restrict frame,
}
void add_local_reference_no_recurse(StackFrame *restrict frame, LispVal *obj) {
if (!OBJECTP(obj)) {
return;
}
frame = frame->last_references;
assert(frame->kind == STACK_FRAME_LOCAL_REFERENCES);
StackFrame *current_frame = OBJECT_LOWEST_LOCAL_REFERENCE(obj);
if (OBJECTP(obj) && (!current_frame || current_frame > frame)) {
if (!current_frame || current_frame > frame) {
store_local_reference_in_frame(frame, obj);
}
}
@@ -173,7 +176,8 @@ add_local_refs_for_object_sub_vals(StackFrame *restrict frame,
case TYPE_SYMBOL: {
LispSymbol *sym = val;
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->name);
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->value);
add_local_ref_if_not_seen_no_recurse(frame, seen_objs,
SYMBOL_VALUE(sym));
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->function);
add_local_ref_if_not_seen_no_recurse(frame, seen_objs, sym->plist);
break;
@@ -216,6 +220,9 @@ add_local_refs_for_object_sub_vals(StackFrame *restrict frame,
}
void add_local_reference(StackFrame *restrict frame, LispVal *obj) {
if (!OBJECTP(obj)) {
return;
}
frame = frame->last_references;
assert(frame->kind == STACK_FRAME_LOCAL_REFERENCES);
add_local_reference_no_recurse(frame, obj);
@@ -231,20 +238,37 @@ void add_local_reference(StackFrame *restrict frame, LispVal *obj) {
void push_dynamic_binding(LispVal *name, LispVal *new_value) {
assert(SYMBOLP(name));
LispVal *old_val = SYMBOL_VALUE(name);
SET_SYMBOL_VALUE(name, new_value); // will throw if name is const
StackFrame *frame = PUSH_NEW_FRAME(STACK_FRAME_DYNAMIC_BINDING);
frame->dynamic_binding.symbol = name;
if (name == Qlexical_environment) {
frame->dynamic_binding.old_value = Vlexical_environment;
Vlexical_environment = new_value;
} else {
frame->dynamic_binding.old_value = SYMBOL_VALUE(name);
SET_SYMBOL_VALUE(name, new_value);
}
frame->dynamic_binding.old_value = old_val;
}
void set_lexical_variable(LispVal *name, LispVal *value) {
assert(SYMBOLP(name));
Vlexical_environment = Fplist_put(Vlexical_environment, name, value);
if (CONST_VALUE_P(name)) {
// TODO throw
abort();
}
if (DYNAMIC_SYMBOL_P(name)) {
SET_SYMBOL_VALUE(name, value);
} else {
Vlexical_environment = Fplist_put(Vlexical_environment, name, value);
}
}
void new_lexical_variable(LispVal *name, LispVal *value) {
assert(SYMBOLP(name));
if (CONST_VALUE_P(name)) {
// TODO throw
abort();
}
if (DYNAMIC_SYMBOL_P(name)) {
SET_SYMBOL_VALUE(name, value);
} else {
Vlexical_environment = CONS(name, CONS(value, Vlexical_environment));
}
}
void unwind_to(StackFrame *frame) {
src/stack.h
+1 -3
View File
@@ -142,9 +142,7 @@ static ALWAYS_INLINE void push_copy_lexenv(void) {
void set_lexical_variable(LispVal *name, LispVal *value);
// Just add a new lexical variable without any checking
static inline void new_lexical_variable(LispVal *name, LispVal *value) {
Vlexical_environment = CONS(name, CONS(value, Vlexical_environment));
}
void new_lexical_variable(LispVal *name, LispVal *value);
void unwind_to(StackFrame *frame);
static ALWAYS_INLINE LispVal *UNWIND_AND_RETURN(StackFrame *frame,