static object *gval (atom_object * var);
+static void subr_NTH ();
+
// Upon initial entry, `cf->args.body[0]` is the FORM, and
// `ret` is the result of evaluating the FORM's first position.
// Typically, the first position will be an ATOM, which is
}
if (val->type == EVALTYPE_SUBR)
CALL_THEN_RET (val->subr.val.fn, new_tuple (args, argct));
+ if (val->type == EVALTYPE_FIX32 || val->type == EVALTYPE_FIX64)
+ {
+ pool_ptr p = as_list (&cf->args.body[0])->val.head;
+ object * args = cst;
+ *cst++ = *val;
+ cst++->pool = *POOL_OBJECT (POOL_OBJECT (p)->rest);
+ assert (!POOL_OBJECT (POOL_OBJECT (p)->rest)->rest);
+ CALL_THEN_RET (subr_NTH, new_tuple (args, 2));
+ }
assert (0 && "I don't know how to call that");
break;
- /*
- case EVALTYPE_FIX32:
- case EVALTYPE_FIX64:
- break;
- */
+ }
+ case EVALTYPE_FIX32:
+ case EVALTYPE_FIX64:
+ {
+ pool_ptr p = as_list (&cf->args.body[0])->val.head;
+ object * args = cst;
+ *cst++ = ret;
+ assert (POOL_OBJECT (p)->rest);
+ cst++->pool = *POOL_OBJECT (POOL_OBJECT (p)->rest);
+ assert (!POOL_OBJECT (POOL_OBJECT (p)->rest)->rest);
+ CALL_THEN_RET (subr_NTH, new_tuple (args, 2));
}
default:
assert (0 && "I don't know how to call that");
eval_arg ()? : appl_add ();
}
+static void appl_NTH ()
+{
+ assert (cf->args.len == 2);
+ int ix;
+ switch (cf->args.body[0].type)
+ {
+ case EVALTYPE_FIX32:
+ case EVALTYPE_FIX64:
+ ix = cf->args.body[0].fix64.val.n;
+ assert ((uint64_t)ix == cf->args.body[0].fix64.val.n);
+ break;
+ default:
+ assert (0 && "tried to NTH a strange index type?");
+ }
+ switch (cf->args.body[1].type)
+ {
+ case EVALTYPE_VECTOR:
+ assert (ix < cf->args.body[1].vector.val.len);
+ RETURN (HEAP_OBJECT (cf->args.body[1].vector.val.body)[ix]);
+ case EVALTYPE_UVECTOR:
+ assert (ix < cf->args.body[1].uvector.val.len);
+ RETURN (uv_get (&cf->args.body[1].uvector, ix));
+ case EVALTYPE_LIST:
+ {
+ pool_ptr p = cf->args.body[1].list.val.head;
+ for (int i=0; i<ix; i++) {
+ assert (p);
+ p = POOL_OBJECT (p)->rest;
+ }
+ assert (p);
+ RETURN (*(object*)POOL_OBJECT (p));
+ }
+ }
+ assert (0 && "tried to NTH a strange collection type?");
+}
+
+void subr_NTH ()
+{
+ eval_arg ()? : appl_NTH ();
+}
+
void
init_standard_env ()
{
create_global_binding (root, "QUOTE")->subr = new_subr (subr_quote);
create_global_binding (root, "LIST")->subr = new_subr (subr_list);
create_global_binding (root, "+")->subr = new_subr (subr_add);
+ create_global_binding (root, "NTH")->subr = new_subr (subr_NTH);
}
object *