Remove structure/field names from builtin structure type.

Moves naming policy (strings/symbols) from the VM to the input image.
To restore introspection, derive annotated base types from anonymous builtins.
This commit is contained in:
Jesse D. McDonald 2010-05-24 22:23:40 -05:00
parent 85eed3da7a
commit 061364c75c
5 changed files with 128 additions and 137 deletions

158
builtin.c
View File

@ -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: */

View File

@ -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);

14
gc.c
View File

@ -11,6 +11,7 @@
#include <time.h>
#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)
{

View File

@ -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);
}

View File

@ -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: