1704 |
|
|
1705 |
#if SCM_ENABLE_ELISP |
#if SCM_ENABLE_ELISP |
1706 |
|
|
1707 |
|
static const char s_defun[] = "Symbol's function definition is void"; |
1708 |
|
|
1709 |
SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond); |
SCM_SYNTAX (s_nil_cond, "nil-cond", scm_i_makbimacro, scm_m_nil_cond); |
1710 |
|
|
1711 |
|
/* nil-cond expressions have the form |
1712 |
|
* (nil-cond COND VAL COND VAL ... ELSEVAL) */ |
1713 |
SCM |
SCM |
1714 |
scm_m_nil_cond (SCM xorig, SCM env SCM_UNUSED) |
scm_m_nil_cond (SCM expr, SCM env SCM_UNUSED) |
1715 |
{ |
{ |
1716 |
long len = scm_ilength (SCM_CDR (xorig)); |
const long length = scm_ilength (SCM_CDR (expr)); |
1717 |
SCM_ASSYNT (len >= 1 && (len & 1) == 1, s_expression, "nil-cond"); |
ASSERT_SYNTAX (length >= 0, s_bad_expression, expr); |
1718 |
return scm_cons (SCM_IM_NIL_COND, SCM_CDR (xorig)); |
ASSERT_SYNTAX (length >= 1 && (length % 2) == 1, s_expression, expr); |
1719 |
|
|
1720 |
|
SCM_SETCAR (expr, SCM_IM_NIL_COND); |
1721 |
|
return expr; |
1722 |
} |
} |
1723 |
|
|
1724 |
|
|
1725 |
SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop); |
SCM_SYNTAX (s_atfop, "@fop", scm_i_makbimacro, scm_m_atfop); |
1726 |
|
|
1727 |
|
/* The @fop-macro handles procedure and macro applications for elisp. The |
1728 |
|
* input expression must have the form |
1729 |
|
* (@fop <var> (transformer-macro <expr> ...)) |
1730 |
|
* where <var> must be a symbol. The expression is transformed into the |
1731 |
|
* memoized form of either |
1732 |
|
* (apply <un-aliased var> (transformer-macro <expr> ...)) |
1733 |
|
* if the value of var (across all aliasing) is not a macro, or |
1734 |
|
* (<un-aliased var> <expr> ...) |
1735 |
|
* if var is a macro. */ |
1736 |
SCM |
SCM |
1737 |
scm_m_atfop (SCM xorig, SCM env SCM_UNUSED) |
scm_m_atfop (SCM expr, SCM env SCM_UNUSED) |
1738 |
{ |
{ |
1739 |
SCM x = SCM_CDR (xorig), var; |
SCM location; |
1740 |
SCM_ASSYNT (scm_ilength (x) >= 1, s_expression, "@fop"); |
SCM symbol; |
1741 |
var = scm_symbol_fref (SCM_CAR (x)); |
|
1742 |
/* Passing the symbol name as the `subr' arg here isn't really |
const SCM cdr_expr = SCM_CDR (expr); |
1743 |
right, but without it it can be very difficult to work out from |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1744 |
the error message which function definition was missing. In any |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 1, s_missing_expression, expr); |
1745 |
case, we shouldn't really use SCM_ASSYNT here at all, but instead |
|
1746 |
something equivalent to (signal void-function (list SYM)) in |
symbol = SCM_CAR (cdr_expr); |
1747 |
Elisp. */ |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (symbol), s_bad_variable, symbol, expr); |
1748 |
SCM_ASSYNT (SCM_VARIABLEP (var), |
|
1749 |
"Symbol's function definition is void", |
location = scm_symbol_fref (symbol); |
1750 |
SCM_SYMBOL_CHARS (SCM_CAR (x))); |
ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr); |
1751 |
/* Support `defalias'. */ |
|
1752 |
while (SCM_SYMBOLP (SCM_VARIABLE_REF (var))) |
/* The elisp function `defalias' allows to define aliases for symbols. To |
1753 |
|
* look up such definitions, the chain of symbol definitions has to be |
1754 |
|
* followed up to the terminal symbol. */ |
1755 |
|
while (SCM_SYMBOLP (SCM_VARIABLE_REF (location))) |
1756 |
{ |
{ |
1757 |
var = scm_symbol_fref (SCM_VARIABLE_REF (var)); |
const SCM alias = SCM_VARIABLE_REF (location); |
1758 |
SCM_ASSYNT (SCM_VARIABLEP (var), |
location = scm_symbol_fref (alias); |
1759 |
"Symbol's function definition is void", |
ASSERT_SYNTAX_2 (SCM_VARIABLEP (location), s_defun, symbol, expr); |
|
SCM_SYMBOL_CHARS (SCM_CAR (x))); |
|
1760 |
} |
} |
1761 |
/* Use `var' here rather than `SCM_VARIABLE_REF (var)' because the |
|
1762 |
former allows for automatically picking up redefinitions of the |
/* Memoize the value location belonging to the terminal symbol. */ |
1763 |
corresponding symbol. */ |
SCM_SETCAR (cdr_expr, location); |
1764 |
SCM_SETCAR (x, var); |
|
1765 |
/* If the variable contains a procedure, leave the |
if (!SCM_MACROP (SCM_VARIABLE_REF (location))) |
|
`transformer-macro' in place so that the procedure's arguments |
|
|
get properly transformed, and change the initial @fop to |
|
|
SCM_IM_APPLY. */ |
|
|
if (!SCM_MACROP (SCM_VARIABLE_REF (var))) |
|
1766 |
{ |
{ |
1767 |
SCM_SETCAR (xorig, SCM_IM_APPLY); |
/* Since the location does not contain a macro, the form is a procedure |
1768 |
return xorig; |
* application. Replace `@fop' by `@apply' and transform the expression |
1769 |
|
* including the `transformer-macro'. */ |
1770 |
|
SCM_SETCAR (expr, SCM_IM_APPLY); |
1771 |
|
return expr; |
1772 |
|
} |
1773 |
|
else |
1774 |
|
{ |
1775 |
|
/* Since the location contains a macro, the arguments should not be |
1776 |
|
* transformed, so the `transformer-macro' is cut out. The resulting |
1777 |
|
* expression starts with the memoized variable, that is at the cdr of |
1778 |
|
* the input expression. */ |
1779 |
|
SCM_SETCDR (cdr_expr, SCM_CDADR (cdr_expr)); |
1780 |
|
return cdr_expr; |
1781 |
} |
} |
|
/* Otherwise (the variable contains a macro), the arguments should |
|
|
not be transformed, so cut the `transformer-macro' out and return |
|
|
the resulting expression starting with the variable. */ |
|
|
SCM_SETCDR (x, SCM_CDADR (x)); |
|
|
return x; |
|
1782 |
} |
} |
1783 |
|
|
1784 |
#endif /* SCM_ENABLE_ELISP */ |
#endif /* SCM_ENABLE_ELISP */ |
1792 |
SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine); |
SCM_SYNTAX (s_undefine, "undefine", scm_makacro, scm_m_undefine); |
1793 |
|
|
1794 |
SCM |
SCM |
1795 |
scm_m_undefine (SCM x, SCM env) |
scm_m_undefine (SCM expr, SCM env) |
1796 |
{ |
{ |
1797 |
SCM arg1 = x; |
SCM variable; |
1798 |
x = SCM_CDR (x); |
SCM location; |
1799 |
SCM_ASSYNT (SCM_TOP_LEVEL (env), "bad placement ", s_undefine); |
|
1800 |
SCM_ASSYNT (SCM_CONSP (x) && SCM_NULLP (SCM_CDR (x)), |
const SCM cdr_expr = SCM_CDR (expr); |
1801 |
s_expression, s_undefine); |
ASSERT_SYNTAX (SCM_TOP_LEVEL (env), "Bad undefine placement in", expr); |
1802 |
x = SCM_CAR (x); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1803 |
SCM_ASSYNT (SCM_SYMBOLP (x), s_variable, s_undefine); |
ASSERT_SYNTAX (scm_ilength (cdr_expr) == 1, s_expression, expr); |
1804 |
arg1 = scm_sym2var (x, scm_env_top_level (env), SCM_BOOL_F); |
|
1805 |
SCM_ASSYNT (!SCM_FALSEP (arg1) && !SCM_UNBNDP (SCM_VARIABLE_REF (arg1)), |
variable = SCM_CAR (cdr_expr); |
1806 |
"variable already unbound ", s_undefine); |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (variable), s_bad_variable, variable, expr); |
1807 |
SCM_VARIABLE_SET (arg1, SCM_UNDEFINED); |
location = scm_sym2var (variable, scm_env_top_level (env), SCM_BOOL_F); |
1808 |
#ifdef SICP |
ASSERT_SYNTAX_2 (!SCM_FALSEP (location) |
1809 |
return x; |
&& !SCM_UNBNDP (SCM_VARIABLE_REF (location)), |
1810 |
#else |
"variable already unbound ", variable, expr); |
1811 |
|
SCM_VARIABLE_SET (location, SCM_UNDEFINED); |
1812 |
return SCM_UNSPECIFIED; |
return SCM_UNSPECIFIED; |
|
#endif |
|
1813 |
} |
} |
1814 |
|
|
1815 |
#endif |
#endif |