lref_t lstructure_length(lref_t st)
{
if (!STRUCTUREP(st))
vmerror_wrong_type_n(1, st);
return fixcons(STRUCTURE_DIM(st));
}
lref_t lstructure_layout(lref_t st)
{
if (!STRUCTUREP(st))
vmerror_wrong_type_n(1, st);
return STRUCTURE_LAYOUT(st);
}
bool structure_equal(lref_t sta, lref_t stb)
{
assert(STRUCTUREP(sta));
assert(STRUCTUREP(stb));
if (STRUCTURE_LAYOUT(sta) != STRUCTURE_LAYOUT(stb))
return false;
if (STRUCTURE_DIM(sta) != STRUCTURE_DIM(stb))
return false;
for (size_t ii = 0; ii < STRUCTURE_DIM(sta); ii++)
if (!equalp(STRUCTURE_ELEM(sta, ii), STRUCTURE_ELEM(stb, ii)))
return false;
return true;
}
lref_t lstructurep(lref_t st, lref_t expected_layout)
{
if (!STRUCTUREP(st))
return boolcons(false);
if (!NULLP(expected_layout) && (expected_layout != STRUCTURE_LAYOUT(st)))
return boolcons(false);
return boolcons(true);
}
EVAL_INLINE lref_t apply(lref_t function, size_t argc, lref_t argv[], lref_t *env, lref_t *retval)
{
lref_t args[3];
if (SUBRP(function)) {
return subr_apply(function, argc, argv, env, retval);
} else if (CLOSUREP(function)) {
lref_t c_code = CLOSURE_CODE(function);
*env = extend_env(arg_list_from_buffer(argc, argv),
CAR(c_code),
CLOSURE_ENV(function));
return CDR(c_code); /* tail call */
} else if (argc > 0) {
if (HASHP(function) || STRUCTUREP(function)) {
args[0] = function;
args[1] = argv[0];
args[2] = (argc > 1) ? argv[1] : NIL;
*retval = lslot_ref(MAX2(argc + 1, 2), args);
return NIL;
} else if (SYMBOLP(function)) {
if (HASHP(argv[0]) || STRUCTUREP(argv[0])) {
args[0] = argv[0];
args[1] = function;
args[2] = (argc > 1) ? argv[1] : NIL;
*retval = lslot_ref(MAX2(argc + 1, 2), args);
return NIL;
}
}
}
vmerror_wrong_type(function);
return NIL;
}
lref_t lstructure_ref(lref_t st, lref_t index)
{
if (!STRUCTUREP(st))
vmerror_wrong_type_n(1, st);
if (!FIXNUMP(index))
vmerror_wrong_type_n(2, index);
fixnum_t idx = get_c_fixnum(index);
if ((idx >= 0) && ((size_t) idx < STRUCTURE_DIM(st)))
return STRUCTURE_ELEM(st, idx);
vmerror_index_out_of_bounds(index, st);
return NIL; // unreached
}
lref_t lcopy_structure(lref_t st)
{
if (!STRUCTUREP(st))
vmerror_wrong_type_n(1, st);
lref_t new_st = new_cell(TC_STRUCTURE);
size_t len = STRUCTURE_DIM(st);;
SET_STRUCTURE_DIM(new_st, len);
SET_STRUCTURE_LAYOUT(new_st, STRUCTURE_LAYOUT(st));
SET_STRUCTURE_DATA(new_st, (lref_t *) gc_malloc(len * sizeof(lref_t)));
for (size_t ii = 0; ii < len; ii++)
SET_STRUCTURE_ELEM(new_st, ii, STRUCTURE_ELEM(st, ii));
return new_st;
}
lref_t lstructure_set(lref_t st, lref_t index, lref_t value)
{
if (!STRUCTUREP(st))
vmerror_wrong_type_n(1, st);
if (!FIXNUMP(index))
vmerror_wrong_type_n(2, index);
fixnum_t idx = get_c_fixnum(index);
if ((idx >= 0) && ((size_t) idx < STRUCTURE_DIM(st)))
{
SET_STRUCTURE_ELEM(st, idx, value);
return st;
}
vmerror_index_out_of_bounds(index, st);
return NIL;
}
