#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_string_to_builtin(interp_state_t *state); static void bi_builtin_to_string(interp_state_t *state); static void bi_values(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); static void bi_display(interp_state_t *state); static void bi_register_finalizer(interp_state_t *state); static void bi_current_context(interp_state_t *state); static void bi_call_with_context(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_VALUES, make_builtin_fn(bi_values)); register_builtin(BI_FREEZE, make_builtin_fn(bi_freeze)); register_builtin(BI_IMMUTABLE_P, make_builtin_fn(bi_immutable_p)); register_builtin(BI_DISPLAY, make_builtin_fn(bi_display)); register_builtin(BI_STRING_TO_NUMBER, make_builtin_fn(bi_string_to_number)); register_builtin(BI_REGISTER_FINALIZER, make_builtin_fn(bi_register_finalizer)); register_builtin(BI_STRING_TO_BUILTIN, make_builtin_fn(bi_string_to_builtin)); register_builtin(BI_BUILTIN_TO_STRING, make_builtin_fn(bi_builtin_to_string)); register_builtin(BI_CURRENT_CONTEXT, make_builtin_fn(bi_current_context)); register_builtin(BI_CALL_WITH_CONTEXT, make_builtin_fn(bi_call_with_context)); } 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 reverse_lookup_builtin(value_t value) { for (value_t list = builtin_list.value; !is_nil(list); list = _CDDR(list)) { if (_CADR(list) == value) { return _CAR(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_string_to_builtin(interp_state_t *state) { char *str; value_t rval; str = value_to_string(CAR(state->argv.value)); rval = lookup_builtin(str); free(str); interp_return_values(state, cons(rval, NIL)); } static void bi_builtin_to_string(interp_state_t *state) { value_t rval = reverse_lookup_builtin(CAR(state->argv.value)); interp_return_values(state, cons(rval, NIL)); } static void bi_values(interp_state_t *state) { interp_return_values(state, state->argv.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)); } static void bi_display(interp_state_t *state) { fprint_value(stdout, CAR(state->argv.value)); fflush(stdout); interp_return_values(state, NIL); } static void bi_register_finalizer(interp_state_t *state) { register_finalizer(CAR(state->argv.value), CAR(_CDR(state->argv.value))); interp_return_values(state, NIL); } static void bi_current_context(interp_state_t *state) { interp_return_values(state, cons(state->ctx.value, NIL)); } static void bi_call_with_context(interp_state_t *state) { state->ctx.value = CAR(state->argv.value); state->lambda.value = CAR(_CDR(state->argv.value)); state->argv.value = NIL; state->kw_args.value = NIL; state->kw_vals.value = NIL; } /* vim:set sw=2 expandtab: */