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

Add a helper function for creating structure types.

This commit is contained in:
Jesse D. McDonald 2010-07-27 23:43:23 -05:00
parent 892af308ce
commit 42312e394a
4 changed files with 78 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
builtin.c
View File

@ -9,27 +9,23 @@
#include "interp.h"
static gc_root_t builtin_list;
static gc_root_t template_type_root;
static gc_root_t lambda_type_root;
static gc_root_t template_type_root;
static void register_structure(void);
static void register_template(void);
static void register_lambda(void);
static void bi_string_to_number(interp_state_t *state);
static void bi_freeze(interp_state_t *state);
static void bi_immutable_p(interp_state_t *state);
static void bi_string_to_number(interp_state_t *state);
void builtin_init(void)
{
register_gc_root(&builtin_list, NIL);
register_gc_root(&template_type_root, UNDEFINED);
register_gc_root(&lambda_type_root, UNDEFINED);
register_gc_root(&lambda_type_root, make_struct_type(NIL, LAMBDA_SLOTS, FALSE_VALUE));
register_gc_root(&template_type_root, make_struct_type(NIL, TEMPLATE_SLOTS, FALSE_VALUE));
register_builtin(BI_UNDEFINED, UNDEFINED);
register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number));
register_builtin(BI_FREEZE, make_builtin_fn(bi_freeze));
register_builtin(BI_IMMUTABLE_P, make_builtin_fn(bi_immutable_p));
register_builtin(BI_STRUCTURE, get_structure_type());
register_builtin(BI_LAMBDA, lambda_type_root.value);
register_builtin(BI_TEMPLATE, template_type_root.value);
#ifdef NAN
register_builtin(BI_POS_NAN, make_float(NAN));
@ -41,9 +37,10 @@ void builtin_init(void)
register_builtin(BI_NEG_INFINITY, make_float(-INFINITY));
#endif
register_structure();
register_template();
register_lambda();
register_builtin(BI_FREEZE, make_builtin_fn(bi_freeze));
register_builtin(BI_IMMUTABLE_P, make_builtin_fn(bi_immutable_p));
register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number));
}
void register_builtin(const char *name, value_t value)
@ -82,69 +79,6 @@ value_t get_lambda_type(void)
return lambda_type_root.value;
}
#define SS(x) STRUCTURE_SLOT_ ## x
static void register_structure(void)
{
register_builtin(BI_STRUCTURE, get_structure_type());
}
static void register_template(void)
{
/* Template: Instances of this structure describe what a LAMBDA
* will look like when instanciated with the 'lambda' bytecode. */
template_type_root.value = make_struct(get_structure_type());
/* 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(NSLOTS)] = 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;
_get_struct(template_type_root.value)->immutable = true;
register_builtin(BI_TEMPLATE, template_type_root.value);
}
static void register_lambda(void)
{
/* Lambda: Instances of this structure are fundamental callable objects. */
lambda_type_root.value = make_struct(get_structure_type());
/* 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(NSLOTS)] = 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;
_get_struct(lambda_type_root.value)->immutable = true;
register_builtin(BI_LAMBDA, lambda_type_root.value);
}
#undef SS
static void bi_string_to_number(interp_state_t *state)
{
char *str;
char *end;
fixnum_t num;
value_t rval;
str = value_to_string(CAR(state->argv.value));
num = strtol(str, &end, 0);
free(str);
if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num))
rval = fixnum_value(num);
else
rval = FALSE_VALUE;
interp_return_values(state, cons(rval, NIL));
}
static void bi_freeze(interp_state_t *state)
{
value_t val = CAR(state->argv.value);
@ -193,4 +127,23 @@ static void bi_immutable_p(interp_state_t *state)
interp_return_values(state, cons(boolean_value(frozen), NIL));
}
static void bi_string_to_number(interp_state_t *state)
{
char *str;
char *end;
fixnum_t num;
value_t rval;
str = value_to_string(CAR(state->argv.value));
num = strtol(str, &end, 0);
free(str);
if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num))
rval = fixnum_value(num);
else
rval = FALSE_VALUE;
interp_return_values(state, cons(rval, NIL));
}
/* vim:set sw=2 expandtab: */

23
builtin.h
View File

@ -10,25 +10,19 @@
/* Names of fundamental builtin values */
#define BI_UNDEFINED "undefined"
#define BI_STRUCTURE "structure"
#define BI_TEMPLATE "template"
#define BI_LAMBDA "lambda"
#define BI_TEMPLATE "template"
#define BI_POS_NAN "+NaN"
#define BI_NEG_NAN "-NaN"
#define BI_POS_INFINITY "+infinity"
#define BI_NEG_INFINITY "-infinity"
/* Names of builtin functions */
#define BI_STRING_TO_NUMBER "string->number"
#define BI_FREEZE "freeze!"
#define BI_IMMUTABLE_P "immutable?"
#define BI_STRING_TO_NUMBER "string->number"
#define TEMPLATE_SLOT_GLOBAL_VARS 0
#define TEMPLATE_SLOT_INSTANCE_VARS 1
#define TEMPLATE_SLOT_FRAME_VARS 2
#define TEMPLATE_SLOT_BYTE_CODE 3
#define TEMPLATE_SLOT_TAIL_CALL 4
#define TEMPLATE_SLOTS 5
/* Lambda: Instances of this structure are fundamental callable objects. */
#define LAMBDA_SLOT_GLOBAL_VARS 0
#define LAMBDA_SLOT_INSTANCE_VARS 1
#define LAMBDA_SLOT_FRAME_VARS 2
@ -36,8 +30,17 @@
#define LAMBDA_SLOT_TAIL_CALL 4
#define LAMBDA_SLOTS 5
value_t get_template_type(void);
/* Template: Instances of this structure describe what a LAMBDA
* will look like when instanciated with the 'lambda' bytecode. */
#define TEMPLATE_SLOT_GLOBAL_VARS 0
#define TEMPLATE_SLOT_INSTANCE_VARS 1
#define TEMPLATE_SLOT_FRAME_VARS 2
#define TEMPLATE_SLOT_BYTE_CODE 3
#define TEMPLATE_SLOT_TAIL_CALL 4
#define TEMPLATE_SLOTS 5
value_t get_lambda_type(void);
value_t get_template_type(void);
void builtin_init(void);
void register_builtin(const char *name, value_t value);

41
gc.c
View File

@ -276,19 +276,45 @@ static void structure_init(void)
register_gc_root(&structure_type_root, object_value(s));
#define SS(x) STRUCTURE_SLOT_ ## x
/* Slot 1: List of superclasses, most to least specific */
_get_struct(structure_type_root.value)->slots[SS(SUPERS)] = NIL;
_get_struct(structure_type_root.value)->slots[STRUCTURE_SLOT_SUPERS] = NIL;
/* Slot 2: Total number of slots (excl. type) */
_get_struct(structure_type_root.value)->slots[SS(NSLOTS)] = fixnum_value(STRUCTURE_SLOTS);
_get_struct(structure_type_root.value)->slots[STRUCTURE_SLOT_NSLOTS] = 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;
#undef SS
_get_struct(structure_type_root.value)->slots[STRUCTURE_SLOT_CALLABLE] = FALSE_VALUE;
_get_struct(structure_type_root.value)->immutable = true;
}
value_t get_structure_type(void)
{
return structure_type_root.value;
}
value_t make_struct_type(value_t supers, fixnum_t nslots, value_t callable)
{
gc_root_t supers_root;
gc_root_t callable_root;
value_t result;
register_gc_root(&supers_root, supers);
register_gc_root(&callable_root, callable);
result = make_struct(get_structure_type());
_get_struct(result)->slots[STRUCTURE_SLOT_SUPERS] = supers;
_get_struct(result)->slots[STRUCTURE_SLOT_NSLOTS] = fixnum_value(nslots);
_get_struct(result)->slots[STRUCTURE_SLOT_CALLABLE] = callable;
_get_struct(result)->immutable = true;
unregister_gc_root(&supers_root);
unregister_gc_root(&callable_root);
return result;
}
bool struct_is_a(value_t value, value_t type)
{
value_t tortoise, hare;
@ -327,11 +353,6 @@ bool struct_is_a(value_t value, value_t type)
return false;
}
value_t get_structure_type(void)
{
return structure_type_root.value;
}
struct_t *get_struct(value_t v)
{
release_assert(is_struct(v));

3
gc.h
View File

@ -229,6 +229,9 @@ value_t make_struct(value_t type);
struct_t *get_struct(value_t v);
value_t get_structure_type(void);
/* Instantiates a structure type. Result is immutable. */
value_t make_struct_type(value_t supers, fixnum_t nslots, value_t callable);
/* True if 'value' is (1) a structure, and (2) an instance of 'type'. */
bool struct_is_a(value_t value, value_t type);