151 |
* detected, a 'Bad variable' error is signalled. */ |
* detected, a 'Bad variable' error is signalled. */ |
152 |
static const char s_bad_variable[] = "Bad variable"; |
static const char s_bad_variable[] = "Bad variable"; |
153 |
|
|
154 |
|
/* Bindings for forms like 'let' and 'do' have to be given in a proper, |
155 |
|
* possibly empty list. If any other object is detected in a place where a |
156 |
|
* list of bindings was required, a 'Bad bindings' error is signalled. */ |
157 |
|
static const char s_bad_bindings[] = "Bad bindings"; |
158 |
|
|
159 |
|
/* Depending on the syntactic context, a binding has to be in the format |
160 |
|
* (<variable> <expression>) or (<variable> <expression1> <expression2>). |
161 |
|
* If anything else is detected in a place where a binding was expected, a |
162 |
|
* 'Bad binding' error is signalled. */ |
163 |
|
static const char s_bad_binding[] = "Bad binding"; |
164 |
|
|
165 |
|
/* If the exit form of a 'do' expression is not in the format |
166 |
|
* (<test> <expression> ...) |
167 |
|
* a 'Bad exit clause' error is signalled. */ |
168 |
|
static const char s_bad_exit_clause[] = "Bad exit clause"; |
169 |
|
|
170 |
|
|
171 |
/* Signal a syntax error. We distinguish between the form that caused the |
/* Signal a syntax error. We distinguish between the form that caused the |
172 |
* error and the enclosing expression. The error message will print out as |
* error and the enclosing expression. The error message will print out as |
982 |
} |
} |
983 |
|
|
984 |
|
|
985 |
|
SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do); |
986 |
|
SCM_GLOBAL_SYMBOL(scm_sym_do, s_do); |
987 |
|
|
988 |
/* DO gets the most radically altered syntax. The order of the vars is |
/* DO gets the most radically altered syntax. The order of the vars is |
989 |
* reversed here. In contrast, the order of the inits and steps is reversed |
* reversed here. In contrast, the order of the inits and steps is reversed |
990 |
* during the evaluation: |
* during the evaluation: |
991 |
|
|
992 |
(do ((<var1> <init1> <step1>) |
(do ((<var1> <init1> <step1>) |
993 |
(<var2> <init2>) |
(<var2> <init2>) |
994 |
... ) |
... ) |
995 |
(<test> <return>) |
(<test> <return>) |
996 |
<body>) |
<body>) |
997 |
|
|
998 |
;; becomes |
;; becomes |
999 |
|
|
1000 |
(#@do (<init1> <init2> ... <initn>) |
(#@do (<init1> <init2> ... <initn>) |
1001 |
(varn ... var2 var1) |
(varn ... var2 var1) |
1002 |
(<test> <return>) |
(<test> <return>) |
1003 |
(<body>) |
(<body>) |
1004 |
<step1> <step2> ... <stepn>) ;; missing steps replaced by var |
<step1> <step2> ... <stepn>) ;; missing steps replaced by var |
1005 |
*/ |
*/ |
|
|
|
|
SCM_SYNTAX(s_do, "do", scm_i_makbimacro, scm_m_do); |
|
|
SCM_GLOBAL_SYMBOL(scm_sym_do, s_do); |
|
|
|
|
1006 |
SCM |
SCM |
1007 |
scm_m_do (SCM xorig, SCM env SCM_UNUSED) |
scm_m_do (SCM expr, SCM env SCM_UNUSED) |
1008 |
{ |
{ |
1009 |
SCM bindings; |
SCM variables = SCM_EOL; |
1010 |
SCM x = SCM_CDR (xorig); |
SCM init_forms = SCM_EOL; |
1011 |
SCM vars = SCM_EOL; |
SCM step_forms = SCM_EOL; |
1012 |
SCM inits = SCM_EOL; |
SCM binding_idx; |
1013 |
SCM *initloc = &inits; |
SCM cddr_expr; |
1014 |
SCM steps = SCM_EOL; |
SCM exit_clause; |
1015 |
SCM *steploc = &steps; |
SCM commands; |
1016 |
SCM_ASSYNT (scm_ilength (x) >= 2, s_test, "do"); |
SCM tail; |
1017 |
bindings = SCM_CAR (x); |
|
1018 |
SCM_ASSYNT (scm_ilength (bindings) >= 0, s_bindings, "do"); |
const SCM cdr_expr = SCM_CDR (expr); |
1019 |
while (!SCM_NULLP (bindings)) |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 0, s_bad_expression, expr); |
1020 |
{ |
ASSERT_SYNTAX (scm_ilength (cdr_expr) >= 2, s_missing_expression, expr); |
1021 |
SCM binding = SCM_CAR (bindings); |
|
1022 |
long len = scm_ilength (binding); |
/* Collect variables, init and step forms. */ |
1023 |
SCM_ASSYNT (len == 2 || len == 3, s_bindings, "do"); |
binding_idx = SCM_CAR (cdr_expr); |
1024 |
|
ASSERT_SYNTAX_2 (scm_ilength (binding_idx) >= 0, |
1025 |
|
s_bad_bindings, binding_idx, expr); |
1026 |
|
for (; !SCM_NULLP (binding_idx); binding_idx = SCM_CDR (binding_idx)) |
1027 |
|
{ |
1028 |
|
const SCM binding = SCM_CAR (binding_idx); |
1029 |
|
const long length = scm_ilength (binding); |
1030 |
|
ASSERT_SYNTAX_2 (length == 2 || length == 3, |
1031 |
|
s_bad_binding, binding, expr); |
1032 |
|
|
1033 |
{ |
{ |
1034 |
SCM name = SCM_CAR (binding); |
const SCM name = SCM_CAR (binding); |
1035 |
SCM init = SCM_CADR (binding); |
const SCM init = SCM_CADR (binding); |
1036 |
SCM step = (len == 2) ? name : SCM_CADDR (binding); |
const SCM step = (length == 2) ? name : SCM_CADDR (binding); |
1037 |
SCM_ASSYNT (SCM_SYMBOLP (name), s_variable, "do"); |
ASSERT_SYNTAX_2 (SCM_SYMBOLP (name), s_bad_variable, name, expr); |
1038 |
vars = scm_cons (name, vars); |
variables = scm_cons (name, variables); |
1039 |
*initloc = scm_list_1 (init); |
init_forms = scm_cons (init, init_forms); |
1040 |
initloc = SCM_CDRLOC (*initloc); |
step_forms = scm_cons (step, step_forms); |
|
*steploc = scm_list_1 (step); |
|
|
steploc = SCM_CDRLOC (*steploc); |
|
|
bindings = SCM_CDR (bindings); |
|
1041 |
} |
} |
1042 |
} |
} |
1043 |
x = SCM_CDR (x); |
init_forms = scm_reverse_x (init_forms, SCM_UNDEFINED); |
1044 |
SCM_ASSYNT (scm_ilength (SCM_CAR (x)) >= 1, s_test, "do"); |
step_forms = scm_reverse_x (step_forms, SCM_UNDEFINED); |
1045 |
x = scm_cons2 (SCM_CAR (x), SCM_CDR (x), steps); |
|
1046 |
x = scm_cons2 (inits, vars, x); |
/* Memoize the test form and the exit sequence. */ |
1047 |
return scm_cons (SCM_IM_DO, x); |
cddr_expr = SCM_CDR (cdr_expr); |
1048 |
|
exit_clause = SCM_CAR (cddr_expr); |
1049 |
|
ASSERT_SYNTAX_2 (scm_ilength (exit_clause) >= 1, |
1050 |
|
s_bad_exit_clause, exit_clause, expr); |
1051 |
|
|
1052 |
|
commands = SCM_CDR (cddr_expr); |
1053 |
|
tail = scm_cons2 (exit_clause, commands, step_forms); |
1054 |
|
tail = scm_cons2 (init_forms, variables, tail); |
1055 |
|
SCM_SETCAR (expr, SCM_IM_DO); |
1056 |
|
SCM_SETCDR (expr, tail); |
1057 |
|
return expr; |
1058 |
} |
} |
1059 |
|
|
1060 |
|
|