#include #include #include #include #include #include "gc.h" #include "builtin.h" #include "interp.h" static gc_root_t builtin_list; static gc_root_t template_type_root; static gc_root_t lambda_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); 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_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)); #ifdef NAN register_builtin(BI_POS_NAN, make_float(NAN)); register_builtin(BI_NEG_NAN, make_float(-NAN)); #endif #ifdef INFINITY register_builtin(BI_POS_INFINITY, make_float(INFINITY)); register_builtin(BI_NEG_INFINITY, make_float(-INFINITY)); #endif register_structure(); register_template(); register_lambda(); } void register_builtin(const char *name, value_t value) { gc_root_t name_root; register_gc_root(&name_root, string_to_value(name)); builtin_list.value = cons(value, builtin_list.value); builtin_list.value = cons(name_root.value, builtin_list.value); unregister_gc_root(&name_root); } value_t lookup_builtin(const char *name) { value_t name_val = string_to_value(name); for (value_t list = builtin_list.value; !is_nil(list); list = _CDDR(list)) { if (byte_strcmp(_CAR(list), name_val) == 0) { return _CADR(list); } } return FALSE_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) { 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); if (is_vector(val)) { _get_vector(val)->immutable = true; } else if (is_byte_string(val)) { _get_byte_string(val)->immutable = true; } else if (is_struct(val)) { _get_struct(val)->immutable = true; } interp_return_values(state, cons(val, NIL)); } static void bi_immutable_p(interp_state_t *state) { value_t val; bool frozen; val = CAR(state->argv.value); if (is_vector(val)) { frozen = _get_vector(val)->immutable; } else if (is_byte_string(val)) { frozen = _get_byte_string(val)->immutable; } else if (is_struct(val)) { frozen = _get_struct(val)->immutable; } else { /* These values can't be changed, and thus can be considered frozen: */ frozen = !is_object(val) || is_float(val) || is_builtin_fn(val); } interp_return_values(state, cons(boolean_value(frozen), NIL)); } /* vim:set sw=2 expandtab: */