object *expand_clauses(object *clauses) {
object *first;
object *rest;
if (is_the_empty_list(clauses)) {
return false;
}
else {
first = car(clauses);
rest = cdr(clauses);
if (is_cond_else_clause(first)) {
if (is_the_empty_list(rest)) {
return sequence_to_exp(cond_actions(first));
}
else {
fprintf(stderr, "else clause isn't last cond->if");
exit(1);
}
}
else {
return make_if(cond_predicate(first),
sequence_to_exp(cond_actions(first)),
expand_clauses(rest));
}
}
}
static pSlipObject expand_clauses(pSlip gd, pSlipObject clauses)
{
pSlipObject first;
pSlipObject rest;
if (sIsObject_EmptyList(gd, clauses) == S_TRUE)
{
return gd->singleton_False;
}
else
{
first = car(clauses);
rest = cdr(clauses);
if (is_cond_else_clause(gd, first) == S_TRUE)
{
if (sIsObject_EmptyList(gd, rest) == S_TRUE)
{
return sequence_to_exp(gd, cond_actions(first));
}
else
{
throw_error(gd, "else clause isn't last cond->if");
return gd->singleton_False;
}
}
else
{
return make_if(gd, cond_predicate(first), sequence_to_exp(gd, cond_actions(first)), expand_clauses(gd, rest));
}
}
}
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));
}
//one arg: clauses
static cellpoint expand_clauses(void)
{
if (is_true(is_null(args_ref(1)))){
reg = a_false;
}else {
args_push(car(args_ref(1)));
reg = is_cond_else_clause();
if (is_true(reg)){
reg = cdr(args_ref(1));
if(is_true(is_null(reg))){
//calls cond_actions
args_push(car(args_ref(1)));
reg = cond_actions();
//calls sequence_2_exp
args_push(reg);
reg = sequence_2_exp();
}else {
printf("Error: ELSE clause isn't last clause in cond expression.\n");
error_handler();
}
}else {
//calls cond_predicate
args_push(car(args_ref(1)));
reg = cond_predicate();
stack_push(&vars_stack, reg);
//calls sequence_2_exp
args_push(car(args_ref(1)));
reg = cond_actions();
args_push(reg);
reg = sequence_2_exp();
stack_push(&vars_stack, reg);
//calls expand_clauses to expand the rest clauses
args_push(cdr(args_ref(1)));
reg = expand_clauses();
//calls make_if
args_push(reg);
args_push(stack_pop(&vars_stack));
args_push(stack_pop(&vars_stack));
reg = make_if();
}
}
args_pop(1);
return reg;
}
object *expand_clauses(object *clauses) {
object *first;
object *rest;
if (is_empty(clauses))
return false;
first = car(clauses);
rest = cdr(clauses);
if (!is_cond_else_clause(first))
return make_if(cond_predicate(first), sequence_to_exp(cond_actions(first)), expand_clauses(rest));
if (is_empty(rest))
return sequence_to_exp(cond_actions(first));
fprintf(stderr, "else clause isn't last cond->if");
exit(EXIT_FAILURE);
}
static data_t *expand_clauses(const data_t *clauses) {
data_t *first, *rest;
if(clauses == NULL)
return make_symbol("#f");
first = car(clauses);
rest = cdr(clauses);
if(is_cond_else_clause(first)) {
if(rest == NULL) {
return sequence_to_exp(get_cond_actions(first));
} else {
printf("ELSE clause isn't last -- COND-IF");
return make_symbol("error");
}
}
return make_if(get_cond_predicate(first), sequence_to_exp(get_cond_actions(first)), expand_clauses(rest));
}
