150 lines
3.4 KiB
C
150 lines
3.4 KiB
C
#include <assert.h>
|
|
#include <inttypes.h>
|
|
#include <stdbool.h>
|
|
#include <stdlib.h>
|
|
#include <math.h>
|
|
|
|
#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 = 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: */
|