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:
parent
85eed3da7a
commit
061364c75c
158
builtin.c
158
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: */
|
||||
|
|
|
|||
14
builtin.h
14
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);
|
||||
|
|
|
|||
14
gc.c
14
gc.c
|
|
@ -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)
|
||||
{
|
||||
|
|
|
|||
21
interp.c
21
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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
Loading…
Reference in New Issue