1090 |
} |
} |
1091 |
|
|
1092 |
|
|
|
static const char* s_atdispatch = "@dispatch"; |
|
|
SCM_SYMBOL (sym_atdispatch, s_atdispatch); |
|
|
|
|
|
/* @slot-dispatch is bound privately in the (oop goops) module from goops.c. |
|
|
* As soon as the module system allows us to more freely create bindings in |
|
|
* arbitrary modules during the startup phase, the code from goops.c should be |
|
|
* moved here. */ |
|
|
SCM |
|
|
scm_m_atdispatch (SCM xorig, SCM env) |
|
|
#define FUNC_NAME s_atdispatch |
|
|
{ |
|
|
SCM args, n, v, gf, x = SCM_CDR (xorig); |
|
|
SCM_ASSYNT (scm_ilength (x) == 4, scm_s_expression, FUNC_NAME); |
|
|
args = SCM_CAR (x); |
|
|
if (!SCM_CONSP (args) && !SCM_SYMBOLP (args)) |
|
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, args); |
|
|
x = SCM_CDR (x); |
|
|
n = SCM_XEVALCAR (x, env); |
|
|
SCM_VALIDATE_INUM (SCM_ARG2, n); |
|
|
SCM_ASSERT_RANGE (0, n, SCM_INUM (n) >= 1); |
|
|
x = SCM_CDR (x); |
|
|
v = SCM_XEVALCAR (x, env); |
|
|
SCM_VALIDATE_VECTOR (SCM_ARG3, v); |
|
|
x = SCM_CDR (x); |
|
|
gf = SCM_XEVALCAR (x, env); |
|
|
SCM_VALIDATE_PUREGENERIC (SCM_ARG4, gf); |
|
|
return scm_list_5 (SCM_IM_DISPATCH, args, n, v, gf); |
|
|
} |
|
|
#undef FUNC_NAME |
|
|
|
|
|
|
|
1093 |
SCM_SYNTAX (s_future, "future", scm_makmmacro, scm_m_future); |
SCM_SYNTAX (s_future, "future", scm_makmmacro, scm_m_future); |
1094 |
SCM_GLOBAL_SYMBOL (scm_sym_future, s_future); |
SCM_GLOBAL_SYMBOL (scm_sym_future, s_future); |
1095 |
|
|
2453 |
RETURN (scm_i_make_future (scm_closure (SCM_CDR (x), env))); |
RETURN (scm_i_make_future (scm_closure (SCM_CDR (x), env))); |
2454 |
|
|
2455 |
|
|
2456 |
case (SCM_ISYMNUM (SCM_IM_DISPATCH)): |
/* PLACEHOLDER for case (SCM_ISYMNUM (SCM_IM_DISPATCH)): The |
2457 |
{ |
following code (type_dispatch) is intended to be the tail |
2458 |
/* If not done yet, evaluate the operand forms. The result is a |
of the case clause for the internal macro |
2459 |
* list of arguments stored in arg1, which is used to perform the |
SCM_IM_DISPATCH. Please don't remove it from this |
2460 |
* function dispatch. */ |
location without discussing it with Mikael |
2461 |
SCM operand_forms = SCM_CADR (x); |
<djurfeldt@nada.kth.se> */ |
2462 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
|
|
if (SCM_ILOCP (operand_forms)) |
|
|
arg1 = *scm_ilookup (operand_forms, env); |
|
|
else if (SCM_VARIABLEP (operand_forms)) |
|
|
arg1 = SCM_VARIABLE_REF (operand_forms); |
|
|
else if (!SCM_CONSP (operand_forms)) |
|
|
arg1 = *scm_lookupcar (SCM_CDR (x), env, 1); |
|
|
else |
|
|
{ |
|
|
SCM tail = arg1 = scm_list_1 (EVALCAR (operand_forms, env)); |
|
|
operand_forms = SCM_CDR (operand_forms); |
|
|
while (!SCM_NULLP (operand_forms)) |
|
|
{ |
|
|
SCM new_tail = scm_list_1 (EVALCAR (operand_forms, env)); |
|
|
SCM_SETCDR (tail, new_tail); |
|
|
tail = new_tail; |
|
|
operand_forms = SCM_CDR (operand_forms); |
|
|
} |
|
|
} |
|
|
} |
|
|
|
|
2463 |
/* The type dispatch code is duplicated below |
/* The type dispatch code is duplicated below |
2464 |
* (c.f. objects.c:scm_mcache_compute_cmethod) since that |
* (c.f. objects.c:scm_mcache_compute_cmethod) since that |
2465 |
* cuts down execution time for type dispatch to 50%. */ |
* cuts down execution time for type dispatch to 50%. */ |