nybble
/
rosella
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
builtin.c
View File

@ -10,6 +10,8 @@
static gc_root_t builtin_list; static gc_root_t builtin_list;
static gc_root_t structure_type_root; 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_structure(void);
static void register_template(void); static void register_template(void);
@ -19,8 +21,10 @@ static void bi_string_to_number(interp_state_t *state);
void builtin_init(void) 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(&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_UNDEFINED, UNDEFINED);
register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number)); 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; 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 #define SS(x) STRUCTURE_SLOT_ ## x
static void register_structure(void) 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); 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; _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"); /* Slot 1: List of superclasses, most to least specific */
WRITE_BARRIER(structure_type_root.value);
/* Slot 2: List of superclasses, most to least specific */
_get_struct(structure_type_root.value)->slots[SS(SUPERS)] = NIL; _get_struct(structure_type_root.value)->slots[SS(SUPERS)] = NIL;
/* Slot 3: Vector of slot names; size == total number of slots (excl. type) */ /* Slot 2: Total number of slots (excl. type) */
_get_struct(structure_type_root.value)->slots[SS(SLOTS)] = make_vector(STRUCTURE_SLOTS, UNDEFINED); _get_struct(structure_type_root.value)->slots[SS(SLOTS)] = fixnum_value(STRUCTURE_SLOTS);
WRITE_BARRIER(structure_type_root.value); /* Slot 3: Callable object used as proxy when structure is APPLY'd. */
{ /* Can be LAMBDA, callable structure instance, builtin, or FALSE_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. */
_get_struct(structure_type_root.value)->slots[SS(CALLABLE)] = 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); register_builtin(BI_STRUCTURE, structure_type_root.value);
} }
static void register_template(void) 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 /* Template: Instances of this structure describe what a LAMBDA
* will look like when instanciated with the 'lambda' bytecode. */ * will look like when instanciated with the 'lambda' bytecode. */
register_gc_root(&tmp_root, make_struct(structure_type_root.value, STRUCTURE_SLOTS)); template_type_root.value = make_struct(structure_type_root.value, STRUCTURE_SLOTS);
register_builtin(BI_TEMPLATE, tmp_root.value);
/* Slot 1: Name */ /* Slot 1: List of superclasses, most to least specific */
_get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("template"); _get_struct(template_type_root.value)->slots[SS(SUPERS)] = NIL;
WRITE_BARRIER(tmp_root.value); /* Slot 2: Total number of slots (excl. type) */
/* Slot 2: List of superclasses, most to least specific */ _get_struct(template_type_root.value)->slots[SS(SLOTS)] = fixnum_value(TEMPLATE_SLOTS);
_get_struct(tmp_root.value)->slots[SS(SUPERS)] = NIL; /* Slot 3: Callable object used as proxy when structure is APPLY'd. */
/* Slot 3: Vector of slot names; size == total number of slots */ _get_struct(template_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE;
_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;
unregister_gc_root(&tmp_root); register_builtin(BI_TEMPLATE, template_type_root.value);
#undef TS
} }
static void register_lambda(void) 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. */ /* Lambda: Instances of this structure are fundamental callable objects. */
register_gc_root(&tmp_root, make_struct(structure_type_root.value, STRUCTURE_SLOTS)); lambda_type_root.value = make_struct(structure_type_root.value, STRUCTURE_SLOTS);
register_builtin(BI_LAMBDA, tmp_root.value);
/* Slot 1: Name */ /* Slot 1: List of superclasses, most to least specific */
_get_struct(tmp_root.value)->slots[SS(NAME)] = string_to_value("lambda"); _get_struct(lambda_type_root.value)->slots[SS(SUPERS)] = NIL;
WRITE_BARRIER(tmp_root.value); /* Slot 2: Total number of slots (excl. type) */
/* Slot 2: List of superclasses, most to least specific */ _get_struct(lambda_type_root.value)->slots[SS(SLOTS)] = fixnum_value(LAMBDA_SLOTS);
_get_struct(tmp_root.value)->slots[SS(SUPERS)] = NIL; /* Slot 3: Callable object used as proxy when structure is APPLY'd. */
/* Slot 3: Vector of slot names; size == total number of slots */ _get_struct(lambda_type_root.value)->slots[SS(CALLABLE)] = FALSE_VALUE;
_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;
unregister_gc_root(&tmp_root); register_builtin(BI_LAMBDA, lambda_type_root.value);
#undef LS
} }
#undef SS #undef SS
@ -266,8 +198,8 @@ static void bi_string_to_number(interp_state_t *state)
state->lambda.value = state->k.value; state->lambda.value = state->k.value;
state->argv.value = rval; state->argv.value = rval;
state->k.value = FALSE_VALUE;
state->ctx.value = FALSE_VALUE; state->ctx.value = FALSE_VALUE;
state->k.value = FALSE_VALUE;
} }
/* vim:set sw=2 expandtab: */ /* vim:set sw=2 expandtab: */

14
builtin.h
View File

@ -23,12 +23,10 @@
/* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */ /* Ex: _SLOT_VALUE(STRUCTURE, v, NAME) */
#define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s]) #define _SLOT_VALUE(t,v,s) (_get_struct(v)->slots[t ## _SLOT_ ## s])
#define STRUCTURE_SLOT_NAME 0 #define STRUCTURE_SLOT_SUPERS 0
#define STRUCTURE_SLOT_SUPERS 1 #define STRUCTURE_SLOT_SLOTS 1
#define STRUCTURE_SLOT_SLOTS 2 #define STRUCTURE_SLOT_CALLABLE 2
#define STRUCTURE_SLOT_CALLABLE 3 #define STRUCTURE_SLOTS 3
#define STRUCTURE_SLOT_MUTABLE 4
#define STRUCTURE_SLOTS 5
#define TEMPLATE_SLOT_GLOBAL_VARS 0 #define TEMPLATE_SLOT_GLOBAL_VARS 0
#define TEMPLATE_SLOT_INSTANCE_VARS 1 #define TEMPLATE_SLOT_INSTANCE_VARS 1
@ -50,6 +48,10 @@
#define LAMBDA_SLOT_CONTINUATION 7 #define LAMBDA_SLOT_CONTINUATION 7
#define LAMBDA_SLOTS 8 #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 builtin_init(void);
void register_builtin(const char *name, value_t value); void register_builtin(const char *name, value_t value);
value_t lookup_builtin(const char *name); value_t lookup_builtin(const char *name);

14
gc.c
View File

@ -11,6 +11,7 @@
#include <time.h> #include <time.h>
#include "gc.h" #include "gc.h"
#include "builtin.h"
#if _CLOCK_MONOTONIC #if _CLOCK_MONOTONIC
# define TIMING_CLOCK 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)) else if (is_struct(v))
{ {
struct_t *meta = get_struct(_get_struct(v)->type); value_t meta = _get_struct(v)->type;
byte_string_t *str = get_byte_string(meta->slots[0]);
fputs("#S(", f); 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) for (size_t i = 0; i < _get_struct(v)->nslots; ++i)
{ {

21
interp.c
View File

@ -22,11 +22,6 @@
#define ST2 (state->in2.value) #define ST2 (state->in2.value)
#define ST3 (state->in3.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 * Local helper routines
*/ */
@ -60,9 +55,6 @@ static void unregister_state(interp_state_t *state);
void interpreter_init(void) 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) 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); struct_t *s = get_struct(v);
release_assert(struct_is_a(s->type, structure_type_root.value)); release_assert(struct_is_a(s->type, get_structure_type()));
release_assert(_get_boolean(_SLOT_VALUE(STRUCTURE, s->type, MUTABLE)));
release_assert((idx >= 0) && (idx < s->nslots)); release_assert((idx >= 0) && (idx < s->nslots));
s->slots[idx] = newval; s->slots[idx] = newval;
@ -202,11 +193,11 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
value_t temp; value_t temp;
/* If it's not a template object, just return as-is. */ /* 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; return templ;
register_gc_root(&templ_root, 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. */ /* Need to do this first, since it can call the garbage collector. */
temp = make_vector(get_byte_string(get_struct(templ_root.value) 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) static void translate_callable(interp_state_t *state)
{ {
while (!is_builtin_fn(state->lambda.value) && 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 /* 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. */ * 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. */ /* Prepend structure instance to argument list, per proxy protocol. */
state->argv.value = cons(state->lambda.value, state->argv.value); 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 0x18: return make_box(ST1);
case 0x19: { case 0x19: {
vector_t *vec; 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)); vec = get_vector(_SLOT_VALUE(STRUCTURE, ST1, SLOTS));
return make_struct(ST1, vec->size); return make_struct(ST1, vec->size);
} }

58
src/examples/annotated-structs.rla Normal file
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: