lisp_object_t expand_cond_clauses(lisp_object_t clauses) {
if (is_null(clauses)) return EOL;
lisp_object_t first = pair_car(clauses);
lisp_object_t rest = pair_cdr(clauses);
if (is_cond_else_clause(first))
return clause_actions(first);
else
return make_if_form(clause_test(first),
clause_actions(first),
expand_cond_clauses(rest));
}
static SCM
expand_cond (SCM expr, SCM env)
{
const int else_literal_p = expand_env_var_is_free (env, scm_sym_else);
const int arrow_literal_p = expand_env_var_is_free (env, scm_sym_arrow);
const SCM clauses = CDR (expr);
ASSERT_SYNTAX (scm_ilength (clauses) >= 0, s_bad_expression, expr);
ASSERT_SYNTAX (scm_ilength (clauses) >= 1, s_missing_clauses, expr);
return expand_cond_clauses (CAR (clauses), CDR (clauses),
else_literal_p, arrow_literal_p, env);
}
static SCM
expand_cond_clauses (SCM clause, SCM rest, int elp, int alp, SCM env)
{
SCM test;
const long length = scm_ilength (clause);
ASSERT_SYNTAX (length >= 1, s_bad_cond_clause, clause);
test = CAR (clause);
if (scm_is_eq (test, scm_sym_else) && elp)
{
const int last_clause_p = scm_is_null (rest);
ASSERT_SYNTAX (length >= 2, s_bad_cond_clause, clause);
ASSERT_SYNTAX (last_clause_p, s_misplaced_else_clause, clause);
return expand_sequence (CDR (clause), env);
}
if (scm_is_null (rest))
rest = VOID (SCM_BOOL_F);
else
rest = expand_cond_clauses (CAR (rest), CDR (rest), elp, alp, env);
if (length >= 2
&& scm_is_eq (CADR (clause), scm_sym_arrow)
&& alp)
{
SCM tmp = scm_gensym (scm_from_locale_string ("cond "));
SCM new_env = scm_acons (tmp, tmp, env);
ASSERT_SYNTAX (length > 2, s_missing_recipient, clause);
ASSERT_SYNTAX (length == 3, s_extra_expression, clause);
return LET (SCM_BOOL_F,
scm_list_1 (tmp),
scm_list_1 (tmp),
scm_list_1 (expand (test, env)),
CONDITIONAL (SCM_BOOL_F,
LEXICAL_REF (SCM_BOOL_F, tmp, tmp),
CALL (SCM_BOOL_F,
expand (CADDR (clause), new_env),
scm_list_1 (LEXICAL_REF (SCM_BOOL_F,
tmp, tmp))),
rest));
}
/* FIXME length == 1 case */
else
return CONDITIONAL (SCM_BOOL_F,
expand (test, env),
expand_sequence (CDR (clause), env),
rest);
}
lisp_object_t cond2if(lisp_object_t cond_form) {
return expand_cond_clauses(cond_clauses(cond_form));
}
