#include #include #include #include #include #include "gc.h" #include "builtin.h" #include "interp.h" static gc_root_t builtin_list; static gc_root_t lambda_type_root; static gc_root_t template_type_root; 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(&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_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)); 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_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) { 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; } 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)); } 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 = (fixnum_t)strtoll(str, &end, 0); if ((*end == '\0') && (_get_fixnum(fixnum_value(num)) == num)) rval = fixnum_value(num); else rval = FALSE_VALUE; free(str); interp_return_values(state, cons(rval, NIL)); } /* vim:set sw=2 expandtab: */