100 |
* expression is expected, a 'Bad expression' error is signalled. */ |
* expression is expected, a 'Bad expression' error is signalled. */ |
101 |
static const char s_bad_expression[] = "Bad expression"; |
static const char s_bad_expression[] = "Bad expression"; |
102 |
|
|
103 |
|
/* If a form is detected that holds more expressions than are allowed in that |
104 |
|
* contect, an 'Extra expression' error is signalled. */ |
105 |
|
static const char s_extra_expression[] = "Extra expression in"; |
106 |
|
|
107 |
/* Case or cond expressions must have at least one clause. If a case or cond |
/* Case or cond expressions must have at least one clause. If a case or cond |
108 |
* expression without any clauses is detected, a 'Missing clauses' error is |
* expression without any clauses is detected, a 'Missing clauses' error is |
109 |
* signalled. */ |
* signalled. */ |
110 |
static const char s_missing_clauses[] = "Missing clauses"; |
static const char s_missing_clauses[] = "Missing clauses"; |
111 |
|
|
112 |
|
/* If there is an 'else' clause in a case or a cond statement, it must be the |
113 |
|
* last clause. If after the 'else' case clause further clauses are detected, |
114 |
|
* a 'Misplaced else clause' error is signalled. */ |
115 |
|
static const char s_misplaced_else_clause[] = "Misplaced else clause"; |
116 |
|
|
117 |
/* If a case clause is detected that is not in the format |
/* If a case clause is detected that is not in the format |
118 |
* (<label(s)> <expression1> <expression2> ...) |
* (<label(s)> <expression1> <expression2> ...) |
119 |
* a 'Bad case clause' error is signalled. */ |
* a 'Bad case clause' error is signalled. */ |
120 |
static const char s_bad_case_clause[] = "Bad case clause"; |
static const char s_bad_case_clause[] = "Bad case clause"; |
121 |
|
|
|
/* If there is an 'else' clause in a case statement, it must be the last |
|
|
* clause. If after the 'else' case clause further clauses are detected, an |
|
|
* 'Extra case clause' error is signalled. */ |
|
|
static const char s_extra_case_clause[] = "Extra case clause"; |
|
|
|
|
122 |
/* If a case clause is detected where the <label(s)> element is neither a |
/* If a case clause is detected where the <label(s)> element is neither a |
123 |
* proper list nor (in case of the last clause) the syntactic keyword 'else', |
* proper list nor (in case of the last clause) the syntactic keyword 'else', |
124 |
* a 'Bad case labels' error is signalled. Note: If you encounter this error |
* a 'Bad case labels' error is signalled. Note: If you encounter this error |
133 |
* signalled. */ |
* signalled. */ |
134 |
static const char s_duplicate_case_label[] = "Duplicate case label"; |
static const char s_duplicate_case_label[] = "Duplicate case label"; |
135 |
|
|
136 |
|
/* If a cond clause is detected that is not in one of the formats |
137 |
|
* (<test> <expression1> ...) or (else <expression1> <expression2> ...) |
138 |
|
* a 'Bad cond clause' error is signalled. */ |
139 |
|
static const char s_bad_cond_clause[] = "Bad cond clause"; |
140 |
|
|
141 |
|
/* If a cond clause is detected that uses the alternate '=>' form, but does |
142 |
|
* not hold a recipient element for the test result, a 'Missing recipient' |
143 |
|
* error is signalled. */ |
144 |
|
static const char s_missing_recipient[] = "Missing recipient in"; |
145 |
|
|
146 |
|
|
147 |
/* Signal a syntax error. We distinguish between the form that caused the |
/* Signal a syntax error. We distinguish between the form that caused the |
148 |
* error and the enclosing expression. The error message will print out as |
* error and the enclosing expression. The error message will print out as |
635 |
* some memoized forms have different syntax |
* some memoized forms have different syntax |
636 |
*/ |
*/ |
637 |
|
|
|
SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>"); |
|
638 |
SCM_GLOBAL_SYMBOL (scm_sym_else, "else"); |
SCM_GLOBAL_SYMBOL (scm_sym_else, "else"); |
639 |
SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote"); |
SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote"); |
640 |
SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing"); |
SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing"); |
766 |
ASSERT_SYNTAX_2 (SCM_EQ_P (labels, scm_sym_else) && else_literal_p, |
ASSERT_SYNTAX_2 (SCM_EQ_P (labels, scm_sym_else) && else_literal_p, |
767 |
s_bad_case_labels, labels, expr); |
s_bad_case_labels, labels, expr); |
768 |
ASSERT_SYNTAX_2 (SCM_NULLP (SCM_CDR (clauses)), |
ASSERT_SYNTAX_2 (SCM_NULLP (SCM_CDR (clauses)), |
769 |
s_extra_case_clause, SCM_CDR (clauses), expr); |
s_misplaced_else_clause, clause, expr); |
770 |
} |
} |
771 |
|
|
772 |
/* build the new clause */ |
/* build the new clause */ |
795 |
|
|
796 |
SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond); |
SCM_SYNTAX (s_cond, "cond", scm_i_makbimacro, scm_m_cond); |
797 |
SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond); |
SCM_GLOBAL_SYMBOL (scm_sym_cond, s_cond); |
798 |
|
SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>"); |
799 |
|
|
800 |
SCM |
SCM |
801 |
scm_m_cond (SCM xorig, SCM env SCM_UNUSED) |
scm_m_cond (SCM expr, SCM env) |
802 |
{ |
{ |
803 |
SCM cdrx = SCM_CDR (xorig); |
/* Check, whether 'else or '=> is a literal, i. e. not bound to a value. */ |
804 |
SCM clauses = cdrx; |
const int else_literal_p = literal_p (scm_sym_else, env); |
805 |
SCM_ASSYNT (scm_ilength (clauses) >= 1, s_clauses, s_cond); |
const int arrow_literal_p = literal_p (scm_sym_arrow, env); |
806 |
while (!SCM_NULLP (clauses)) |
|
807 |
|
const SCM clauses = SCM_CDR (expr); |
808 |
|
SCM clause_idx; |
809 |
|
|
810 |
|
ASSERT_SYNTAX (scm_ilength (clauses) >= 0, s_bad_expression, expr); |
811 |
|
ASSERT_SYNTAX (scm_ilength (clauses) >= 1, s_missing_clauses, expr); |
812 |
|
|
813 |
|
for (clause_idx = clauses; |
814 |
|
!SCM_NULLP (clause_idx); |
815 |
|
clause_idx = SCM_CDR (clause_idx)) |
816 |
{ |
{ |
817 |
SCM clause = SCM_CAR (clauses); |
SCM test; |
818 |
long len = scm_ilength (clause); |
|
819 |
SCM_ASSYNT (len >= 1, s_clauses, s_cond); |
const SCM clause = SCM_CAR (clause_idx); |
820 |
if (SCM_EQ_P (scm_sym_else, SCM_CAR (clause))) |
const long length = scm_ilength (clause); |
821 |
|
ASSERT_SYNTAX_2 (length >= 1, s_bad_cond_clause, clause, expr); |
822 |
|
|
823 |
|
test = SCM_CAR (clause); |
824 |
|
if (SCM_EQ_P (test, scm_sym_else) && else_literal_p) |
825 |
{ |
{ |
826 |
int last_clause_p = SCM_NULLP (SCM_CDR (clauses)); |
const int last_clause_p = SCM_NULLP (SCM_CDR (clause_idx)); |
827 |
SCM_ASSYNT (len >= 2 && last_clause_p, "bad ELSE clause", s_cond); |
ASSERT_SYNTAX_2 (length >= 2, |
828 |
|
s_bad_cond_clause, clause, expr); |
829 |
|
ASSERT_SYNTAX_2 (last_clause_p, |
830 |
|
s_misplaced_else_clause, clause, expr); |
831 |
|
SCM_SETCAR (clause, SCM_IM_ELSE); |
832 |
} |
} |
833 |
else if (len >= 2 && SCM_EQ_P (scm_sym_arrow, SCM_CADR (clause))) |
else if (length >= 2 |
834 |
{ |
&& SCM_EQ_P (SCM_CADR (clause), scm_sym_arrow) |
835 |
SCM_ASSYNT (len > 2, "missing recipient", s_cond); |
&& arrow_literal_p) |
836 |
SCM_ASSYNT (len == 3, "bad recipient", s_cond); |
{ |
837 |
|
ASSERT_SYNTAX_2 (length > 2, s_missing_recipient, clause, expr); |
838 |
|
ASSERT_SYNTAX_2 (length == 3, s_extra_expression, clause, expr); |
839 |
|
SCM_SETCAR (SCM_CDR (clause), SCM_IM_ARROW); |
840 |
} |
} |
|
clauses = SCM_CDR (clauses); |
|
841 |
} |
} |
842 |
return scm_cons (SCM_IM_COND, cdrx); |
|
843 |
|
SCM_SETCAR (expr, SCM_IM_COND); |
844 |
|
return expr; |
845 |
} |
} |
846 |
|
|
847 |
|
|
1915 |
SCM_SETCDR (z, unmemocar (copy, env)); |
SCM_SETCDR (z, unmemocar (copy, env)); |
1916 |
z = SCM_CDR (z); |
z = SCM_CDR (z); |
1917 |
} |
} |
1918 |
|
else if (SCM_EQ_P (form, SCM_IM_ARROW)) |
1919 |
|
{ |
1920 |
|
SCM_SETCDR (z, scm_cons (scm_sym_arrow, SCM_UNSPECIFIED)); |
1921 |
|
z = SCM_CDR (z); |
1922 |
|
} |
1923 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
1924 |
} |
} |
1925 |
SCM_SETCDR (z, x); |
SCM_SETCDR (z, x); |
2464 |
while (!SCM_NULLP (x)) |
while (!SCM_NULLP (x)) |
2465 |
{ |
{ |
2466 |
SCM clause = SCM_CAR (x); |
SCM clause = SCM_CAR (x); |
2467 |
if (SCM_EQ_P (SCM_CAR (clause), scm_sym_else)) |
if (SCM_EQ_P (SCM_CAR (clause), SCM_IM_ELSE)) |
2468 |
{ |
{ |
2469 |
x = SCM_CDR (clause); |
x = SCM_CDR (clause); |
2470 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2478 |
x = SCM_CDR (clause); |
x = SCM_CDR (clause); |
2479 |
if (SCM_NULLP (x)) |
if (SCM_NULLP (x)) |
2480 |
RETURN (arg1); |
RETURN (arg1); |
2481 |
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow)) |
else if (!SCM_EQ_P (SCM_CAR (x), SCM_IM_ARROW)) |
2482 |
{ |
{ |
2483 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2484 |
goto begin; |
goto begin; |