1579 |
SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont); |
SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_i_makbimacro, scm_m_cont); |
1580 |
SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc); |
SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc); |
1581 |
|
|
|
|
|
1582 |
SCM |
SCM |
1583 |
scm_m_cont (SCM xorig, SCM env SCM_UNUSED) |
scm_m_cont (SCM expr, SCM env SCM_UNUSED) |
1584 |
{ |
{ |
1585 |
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 1, |
const SCM cdr_expr = SCM_CDR (expr); |
1586 |
s_expression, s_atcall_cc); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1587 |
return scm_cons (SCM_IM_CONT, SCM_CDR (xorig)); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr); |
1588 |
|
|
1589 |
|
SCM_SETCAR (expr, SCM_IM_CONT); |
1590 |
|
return expr; |
1591 |
} |
} |
1592 |
|
|
1593 |
|
|
1595 |
SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values); |
SCM_GLOBAL_SYMBOL(scm_sym_at_call_with_values, s_at_call_with_values); |
1596 |
|
|
1597 |
SCM |
SCM |
1598 |
scm_m_at_call_with_values (SCM xorig, SCM env SCM_UNUSED) |
scm_m_at_call_with_values (SCM expr, SCM env SCM_UNUSED) |
1599 |
{ |
{ |
1600 |
SCM_ASSYNT (scm_ilength (SCM_CDR (xorig)) == 2, |
const SCM cdr_expr = SCM_CDR (expr); |
1601 |
s_expression, s_at_call_with_values); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1602 |
return scm_cons (SCM_IM_CALL_WITH_VALUES, SCM_CDR (xorig)); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr); |
1603 |
|
|
1604 |
|
SCM_SETCAR (expr, SCM_IM_CALL_WITH_VALUES); |
1605 |
|
return expr; |
1606 |
} |
} |
1607 |
|
|
1608 |
|
|
1627 |
SCM_SYMBOL (scm_sym_setter, "setter"); |
SCM_SYMBOL (scm_sym_setter, "setter"); |
1628 |
|
|
1629 |
SCM |
SCM |
1630 |
scm_m_generalized_set_x (SCM xorig, SCM env SCM_UNUSED) |
scm_m_generalized_set_x (SCM expr, SCM env SCM_UNUSED) |
1631 |
{ |
{ |
1632 |
SCM x = SCM_CDR (xorig); |
SCM target; |
1633 |
SCM_ASSYNT (2 == scm_ilength (x), s_expression, s_set_x); |
|
1634 |
if (SCM_SYMBOLP (SCM_CAR (x))) |
const SCM cdr_expr = SCM_CDR (expr); |
1635 |
return scm_cons (SCM_IM_SET_X, x); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1636 |
else if (SCM_CONSP (SCM_CAR (x))) |
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 2, s_expression, expr); |
1637 |
return scm_cons (scm_list_2 (scm_sym_setter, SCM_CAAR (x)), |
|
1638 |
scm_append (scm_list_2 (SCM_CDAR (x), SCM_CDR (x)))); |
target = SCM_CAR (cdr_expr); |
1639 |
|
if (!SCM_CONSP (target)) |
1640 |
|
{ |
1641 |
|
/* R5RS usage */ |
1642 |
|
return scm_m_set_x (expr, env); |
1643 |
|
} |
1644 |
else |
else |
1645 |
scm_misc_error (s_set_x, s_variable, SCM_EOL); |
{ |
1646 |
|
/* (set! (foo bar ...) baz) becomes ((setter foo) bar ... baz) */ |
1647 |
|
|
1648 |
|
const SCM setter_proc_tail = scm_list_1 (SCM_CAR (target)); |
1649 |
|
const SCM setter_proc = scm_cons_source (expr, scm_sym_setter, setter_proc_tail); |
1650 |
|
|
1651 |
|
const SCM cddr_expr = SCM_CDR (cdr_expr); |
1652 |
|
const SCM setter_args = scm_append_x (scm_list_2 (SCM_CDR (target), cddr_expr)); |
1653 |
|
|
1654 |
|
SCM_SETCAR (expr, setter_proc); |
1655 |
|
SCM_SETCDR (expr, setter_args); |
1656 |
|
return expr; |
1657 |
|
} |
1658 |
} |
} |
1659 |
|
|
1660 |
|
|