From 42312e394a0221aa4a191ebc0fd1ce6d70afa94b Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Tue, 27 Jul 2010 23:43:23 -0500 Subject: [PATCH] Add a helper function for creating structure types. --- builtin.c | 109 ++++++++++++++++-------------------------------------- builtin.h | 23 +++++++----- gc.c | 41 +++++++++++++++----- gc.h | 3 ++ 4 files changed, 78 insertions(+), 98 deletions(-) diff --git a/builtin.c b/builtin.c index 827b966..ccbe4ad 100644 --- a/builtin.c +++ b/builtin.c @@ -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_UNDEFINED, UNDEFINED); + 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: */ diff --git a/builtin.h b/builtin.h index d64d0d8..8925a7d 100644 --- a/builtin.h +++ b/builtin.h @@ -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); diff --git a/gc.c b/gc.c index e2513dc..b3edb99 100644 --- a/gc.c +++ b/gc.c @@ -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)); diff --git a/gc.h b/gc.h index 8806bf6..996efec 100644 --- a/gc.h +++ b/gc.h @@ -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);