diff --git a/builtin.c b/builtin.c index b413b23..3e6c3d2 100644 --- a/builtin.c +++ b/builtin.c @@ -10,6 +10,8 @@ static gc_root_t builtin_list; static gc_root_t structure_type_root; +static gc_root_t template_type_root; +static gc_root_t lambda_type_root; static void register_structure(void); static void register_template(void); @@ -19,8 +21,10 @@ static void bi_string_to_number(interp_state_t *state); void builtin_init(void) { - register_gc_root(&builtin_list, NIL); + register_gc_root(&builtin_list, NIL); register_gc_root(&structure_type_root, UNDEFINED); + register_gc_root(&template_type_root, UNDEFINED); + register_gc_root(&lambda_type_root, UNDEFINED); register_builtin(BI_UNDEFINED, UNDEFINED); register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number)); @@ -66,142 +70,70 @@ value_t lookup_builtin(const char *name) return FALSE_VALUE; } +value_t get_structure_type(void) +{ + return structure_type_root.value; +} + +value_t get_template_type(void) +{ + return template_type_root.value; +} + +value_t get_lambda_type(void) +{ + return lambda_type_root.value; +} + #define SS(x) STRUCTURE_SLOT_ ## x static void register_structure(void) { - /* (Meta-)Structure: Instances of this structure describe structures. */ + /* Structure: Instances of this structure describe structures. */ + /* It is both a structure and a structure description, and thus an instance of itself. */ structure_type_root.value = make_struct(UNDEFINED, STRUCTURE_SLOTS); - - /* Metastruct is both a structure and a structure description, - * and thus is an instance of itself. */ _get_struct(structure_type_root.value)->type = structure_type_root.value; - /* Slot 1: Name */ - _get_struct(structure_type_root.value)->slots[SS(NAME)] = string_to_value("structure"); - WRITE_BARRIER(structure_type_root.value); - /* Slot 2: List of superclasses, most to least specific */ + + /* Slot 1: List of superclasses, most to least specific */ _get_struct(structure_type_root.value)->slots[SS(SUPERS)] = NIL; - /* Slot 3: Vector of slot names; size == total number of slots (excl. type) */ - _get_struct(structure_type_root.value)->slots[SS(SLOTS)] = make_vector(STRUCTURE_SLOTS, UNDEFINED); - WRITE_BARRIER(structure_type_root.value); - { - gc_root_t vec_root; - register_gc_root(&vec_root, _get_struct(structure_type_root.value)->slots[SS(SLOTS)]); - _get_vector(vec_root.value)->elements[SS(NAME)] = string_to_value("name"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[SS(SUPERS)] = string_to_value("supers"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[SS(SLOTS)] = string_to_value("slots"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[SS(CALLABLE)] = string_to_value("callable"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[SS(MUTABLE)] = string_to_value("mutable"); - WRITE_BARRIER(vec_root.value); - unregister_gc_root(&vec_root); - } - /* Slot 4: Callable object used as proxy when structure is APPLY'd. */ - /* Can be LAMBDA, callable structure instance, or FALSE_VALUE. */ + /* Slot 2: Total number of slots (excl. type) */ + _get_struct(structure_type_root.value)->slots[SS(SLOTS)] = fixnum_value(STRUCTURE_SLOTS); + /* Slot 3: Callable object used as proxy when structure is APPLY'd. */ + /* Can be LAMBDA, callable structure instance, builtin, or FALSE_VALUE. */ _get_struct(structure_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE; - _get_struct(structure_type_root.value)->slots[SS(MUTABLE)] = FALSE_VALUE; register_builtin(BI_STRUCTURE, structure_type_root.value); } static void register_template(void) { - gc_root_t tmp_root; - -#define TS(x) TEMPLATE_SLOT_ ## x - /* Template: Instances of this structure describe what a LAMBDA * will look like when instanciated with the 'lambda' bytecode. */ - register_gc_root(&tmp_root, make_struct(structure_type_root.value, STRUCTURE_SLOTS)); - register_builtin(BI_TEMPLATE, tmp_root.value); + template_type_root.value = make_struct(structure_type_root.value, STRUCTURE_SLOTS); - /* Slot 1: Name */ - _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("template"); - WRITE_BARRIER(tmp_root.value); - /* Slot 2: List of superclasses, most to least specific */ - _get_struct(tmp_root.value)->slots[SS(SUPERS)] = NIL; - /* Slot 3: Vector of slot names; size == total number of slots */ - _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(TEMPLATE_SLOTS, UNDEFINED); - WRITE_BARRIER(tmp_root.value); - { - gc_root_t vec_root; - register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]); - _get_vector(vec_root.value)->elements[TS(GLOBAL_VARS)] = string_to_value("global-vars"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(INSTANCE_VARS)] = string_to_value("instance-vars"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(FRAME_VARS)] = string_to_value("frame-vars"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(BYTE_CODE)] = string_to_value("byte-code"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(TAIL_CALL)] = string_to_value("tail-call"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(ARG_LIST)] = string_to_value("argument-list"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(CONTEXT)] = string_to_value("context"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[TS(CONTINUATION)] = string_to_value("continuation"); - WRITE_BARRIER(vec_root.value); - unregister_gc_root(&vec_root); - } - /* Slot 4: Callable object used as proxy when structure is apply'd. */ - _get_struct(tmp_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE; - _get_struct(tmp_root.value)->slots[SS(MUTABLE)] = FALSE_VALUE; + /* Slot 1: List of superclasses, most to least specific */ + _get_struct(template_type_root.value)->slots[SS(SUPERS)] = NIL; + /* Slot 2: Total number of slots (excl. type) */ + _get_struct(template_type_root.value)->slots[SS(SLOTS)] = fixnum_value(TEMPLATE_SLOTS); + /* Slot 3: Callable object used as proxy when structure is APPLY'd. */ + _get_struct(template_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE; - unregister_gc_root(&tmp_root); - -#undef TS + register_builtin(BI_TEMPLATE, template_type_root.value); } static void register_lambda(void) { - gc_root_t tmp_root; - -#define LS(x) LAMBDA_SLOT_ ## x - /* Lambda: Instances of this structure are fundamental callable objects. */ - register_gc_root(&tmp_root, make_struct(structure_type_root.value, STRUCTURE_SLOTS)); - register_builtin(BI_LAMBDA, tmp_root.value); + lambda_type_root.value = make_struct(structure_type_root.value, STRUCTURE_SLOTS); - /* Slot 1: Name */ - _get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("lambda"); - WRITE_BARRIER(tmp_root.value); - /* Slot 2: List of superclasses, most to least specific */ - _get_struct(tmp_root.value)->slots[SS(SUPERS)] = NIL; - /* Slot 3: Vector of slot names; size == total number of slots */ - _get_struct(tmp_root.value)->slots[SS(SLOTS)] = make_vector(LAMBDA_SLOTS, UNDEFINED); - WRITE_BARRIER(tmp_root.value); - { - gc_root_t vec_root; - register_gc_root(&vec_root, _get_struct(tmp_root.value)->slots[SS(SLOTS)]); - _get_vector(vec_root.value)->elements[LS(GLOBAL_VARS)] = string_to_value("global-vars"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(INSTANCE_VARS)] = string_to_value("instance-vars"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(FRAME_VARS)] = string_to_value("frame-vars"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(BYTE_CODE)] = string_to_value("byte-code"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(TAIL_CALL)] = string_to_value("tail-call"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(ARG_LIST)] = string_to_value("argument-list"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(CONTEXT)] = string_to_value("context"); - WRITE_BARRIER(vec_root.value); - _get_vector(vec_root.value)->elements[LS(CONTINUATION)] = string_to_value("continuation"); - WRITE_BARRIER(vec_root.value); - unregister_gc_root(&vec_root); - } - /* Slot 4: Callable object used as proxy when structure is apply'd. */ - _get_struct(tmp_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE; - _get_struct(tmp_root.value)->slots[SS(MUTABLE)] = FALSE_VALUE; + /* Slot 1: List of superclasses, most to least specific */ + _get_struct(lambda_type_root.value)->slots[SS(SUPERS)] = NIL; + /* Slot 2: Total number of slots (excl. type) */ + _get_struct(lambda_type_root.value)->slots[SS(SLOTS)] = fixnum_value(LAMBDA_SLOTS); + /* Slot 3: Callable object used as proxy when structure is APPLY'd. */ + _get_struct(lambda_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE; - unregister_gc_root(&tmp_root); - -#undef LS + register_builtin(BI_LAMBDA, lambda_type_root.value); } #undef SS @@ -266,8 +198,8 @@ static void bi_string_to_number(interp_state_t *state) state->lambda.value = state->k.value; state->argv.value = rval; - state->k.value = FALSE_VALUE; state->ctx.value = FALSE_VALUE; + state->k.value = FALSE_VALUE; } /* vim:set sw=2 expandtab: */ diff --git a/builtin.h b/builtin.h index 1e8dd25..bb1e22a 100644 --- a/builtin.h +++ b/builtin.h @@ -23,12 +23,10 @@ /* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */ #define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s]) -#define STRUCTURE_SLOT_NAME 0 -#define STRUCTURE_SLOT_SUPERS 1 -#define STRUCTURE_SLOT_SLOTS 2 -#define STRUCTURE_SLOT_CALLABLE 3 -#define STRUCTURE_SLOT_MUTABLE 4 -#define STRUCTURE_SLOTS 5 +#define STRUCTURE_SLOT_SUPERS 0 +#define STRUCTURE_SLOT_SLOTS 1 +#define STRUCTURE_SLOT_CALLABLE 2 +#define STRUCTURE_SLOTS 3 #define TEMPLATE_SLOT_GLOBAL_VARS 0 #define TEMPLATE_SLOT_INSTANCE_VARS 1 @@ -50,6 +48,10 @@ #define LAMBDA_SLOT_CONTINUATION 7 #define LAMBDA_SLOTS 8 +value_t get_structure_type(void); +value_t get_template_type(void); +value_t get_lambda_type(void); + void builtin_init(void); void register_builtin(const char *name, value_t value); value_t lookup_builtin(const char *name); diff --git a/gc.c b/gc.c index b789a24..90dbe0b 100644 --- a/gc.c +++ b/gc.c @@ -11,6 +11,7 @@ #include #include "gc.h" +#include "builtin.h" #if _CLOCK_MONOTONIC # define TIMING_CLOCK CLOCK_MONOTONIC @@ -1505,11 +1506,18 @@ static void _fprint_value(FILE *f, value_t v, seen_value_t *seen) } else if (is_struct(v)) { - struct_t *meta = get_struct(_get_struct(v)->type); - byte_string_t *str = get_byte_string(meta->slots[0]); + value_t meta = _get_struct(v)->type; fputs("#S(", f); - fwrite(str->bytes, str->size, 1, f); + + if (meta == get_structure_type()) + fputs("structure", f); + else if (meta == get_template_type()) + fputs("template", f); + else if (meta == get_lambda_type()) + fputs("lambda", f); + else + _fprint_value(f, meta, &new_seen); for (size_t i = 0; i < _get_struct(v)->nslots; ++i) { diff --git a/interp.c b/interp.c index d8271e8..03bfd05 100644 --- a/interp.c +++ b/interp.c @@ -22,11 +22,6 @@ #define ST2 (state->in2.value) #define ST3 (state->in3.value) -/* Quick references to main builtins */ -static gc_root_t structure_type_root; -static gc_root_t template_type_root; -static gc_root_t lambda_type_root; - /* * Local helper routines */ @@ -60,9 +55,6 @@ static void unregister_state(interp_state_t *state); void interpreter_init(void) { - register_gc_root(&structure_type_root, lookup_builtin(BI_STRUCTURE)); - register_gc_root(&template_type_root, lookup_builtin(BI_TEMPLATE)); - register_gc_root(&lambda_type_root, lookup_builtin(BI_LAMBDA)); } value_t run_interpreter(value_t lambda, value_t argv) @@ -184,8 +176,7 @@ static void struct_set(value_t v, fixnum_t idx, value_t newval) { struct_t *s = get_struct(v); - release_assert(struct_is_a(s->type, structure_type_root.value)); - release_assert(_get_boolean(_SLOT_VALUE(STRUCTURE, s->type, MUTABLE))); + release_assert(struct_is_a(s->type, get_structure_type())); release_assert((idx >= 0) && (idx < s->nslots)); s->slots[idx] = newval; @@ -202,11 +193,11 @@ static value_t make_lambda(interp_state_t *state, value_t templ) value_t temp; /* If it's not a template object, just return as-is. */ - if (!struct_is_a(templ, template_type_root.value)) + if (!struct_is_a(templ, get_template_type())) return templ; register_gc_root(&templ_root, templ); - register_gc_root(&lambda_root, make_struct(lambda_type_root.value, LAMBDA_SLOTS)); + register_gc_root(&lambda_root, make_struct(get_lambda_type(), LAMBDA_SLOTS)); /* Need to do this first, since it can call the garbage collector. */ temp = make_vector(get_byte_string(get_struct(templ_root.value) @@ -246,11 +237,11 @@ static value_t make_lambda(interp_state_t *state, value_t templ) static void translate_callable(interp_state_t *state) { while (!is_builtin_fn(state->lambda.value) && - !struct_is_a(state->lambda.value, lambda_type_root.value)) + !struct_is_a(state->lambda.value, get_lambda_type())) { /* If it's not a lambda, built-in function, or typed structure, then * it's not callable and I have no idea what to do with it. */ - release_assert(struct_is_a(get_struct(state->lambda.value)->type, structure_type_root.value)); + release_assert(struct_is_a(get_struct(state->lambda.value)->type, get_structure_type())); /* Prepend structure instance to argument list, per proxy protocol. */ state->argv.value = cons(state->lambda.value, state->argv.value); @@ -403,7 +394,7 @@ static value_t eval_unary_expression(interp_state_t *state, uint8_t subcode, uin case 0x18: return make_box(ST1); case 0x19: { vector_t *vec; - release_assert(struct_is_a(ST1, structure_type_root.value)); + release_assert(struct_is_a(ST1, get_structure_type())); vec = get_vector(_SLOT_VALUE(STRUCTURE, ST1, SLOTS)); return make_struct(ST1, vec->size); } diff --git a/src/examples/annotated-structs.rla b/src/examples/annotated-structs.rla new file mode 100644 index 0000000..efc7fb7 --- /dev/null +++ b/src/examples/annotated-structs.rla @@ -0,0 +1,58 @@ +#S(#="lambda" + #( + ( + #0=#S(#="structure" + (#="structure") + 5 + #f + ) + #1=#S(#=0 + (#="structure") + 5 + #f + "annotated-structure" + #( + "supers" + "nslots" + "callable" + "name" + "slot-names" + ) + ) + #2=#S(#=1 + (#="lambda") + 8 + #f + "annotated-lambda" + #( + "global-vars" + "instance-vars" + "frame-vars" + "byte-code" + "tail-call" + "arg-list" + "context" + "continuation" + ) + ) + ) + #S(#=2 + #(("OK") #f) + #() + 0 + "" + 0xff + 0x01 + 0x02 + 0x02 + ) + ) + #() + 0 + "" + 0x02 + 0xfd + 0xfe + 0xff +) +; vim:set syntax= sw=3 expandtab: