2121 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2122 |
while (!SCM_NULLP (x)) |
while (!SCM_NULLP (x)) |
2123 |
{ |
{ |
2124 |
proc = SCM_CAR (x); |
SCM clause = SCM_CAR (x); |
2125 |
if (SCM_EQ_P (SCM_CAR (proc), scm_sym_else)) |
if (SCM_EQ_P (SCM_CAR (clause), scm_sym_else)) |
2126 |
{ |
{ |
2127 |
x = SCM_CDR (proc); |
x = SCM_CDR (clause); |
2128 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2129 |
goto begin; |
goto begin; |
2130 |
} |
} |
2131 |
t.arg1 = EVALCAR (proc, env); |
else |
|
if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1)) |
|
2132 |
{ |
{ |
2133 |
x = SCM_CDR (proc); |
t.arg1 = EVALCAR (clause, env); |
2134 |
if (SCM_NULLP (x)) |
if (!SCM_FALSEP (t.arg1) && !SCM_NILP (t.arg1)) |
|
RETURN (t.arg1); |
|
|
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow)) |
|
2135 |
{ |
{ |
2136 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
x = SCM_CDR (clause); |
2137 |
goto begin; |
if (SCM_NULLP (x)) |
2138 |
|
RETURN (t.arg1); |
2139 |
|
else if (!SCM_EQ_P (SCM_CAR (x), scm_sym_arrow)) |
2140 |
|
{ |
2141 |
|
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2142 |
|
goto begin; |
2143 |
|
} |
2144 |
|
else |
2145 |
|
{ |
2146 |
|
proc = SCM_CDR (x); |
2147 |
|
proc = EVALCAR (proc, env); |
2148 |
|
SCM_ASRTGO (!SCM_IMP (proc), badfun); |
2149 |
|
PREP_APPLY (proc, scm_list_1 (t.arg1)); |
2150 |
|
ENTER_APPLY; |
2151 |
|
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) |
2152 |
|
goto umwrongnumargs; |
2153 |
|
else |
2154 |
|
goto evap1; |
2155 |
|
} |
2156 |
} |
} |
2157 |
proc = SCM_CDR (x); |
x = SCM_CDR (x); |
|
proc = EVALCAR (proc, env); |
|
|
SCM_ASRTGO (!SCM_IMP (proc), badfun); |
|
|
PREP_APPLY (proc, scm_list_1 (t.arg1)); |
|
|
ENTER_APPLY; |
|
|
if (SCM_CLOSUREP(proc) && scm_badformalsp (proc, 1)) |
|
|
goto umwrongnumargs; |
|
|
goto evap1; |
|
2158 |
} |
} |
|
x = SCM_CDR (x); |
|
2159 |
} |
} |
2160 |
RETURN (SCM_UNSPECIFIED); |
RETURN (SCM_UNSPECIFIED); |
2161 |
|
|
2162 |
|
|
2163 |
case SCM_BIT8(SCM_IM_DO): |
case SCM_BIT8 (SCM_IM_DO): |
2164 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2165 |
proc = SCM_CADR (x); /* inits */ |
{ |
2166 |
t.arg1 = SCM_EOL; /* values */ |
/* Compute the initialization values and the initial environment. */ |
2167 |
while (!SCM_NULLP (proc)) |
SCM init_forms = SCM_CADR (x); |
2168 |
{ |
SCM init_values = SCM_EOL; |
2169 |
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); |
while (!SCM_NULLP (init_forms)) |
2170 |
proc = SCM_CDR (proc); |
{ |
2171 |
} |
init_values = scm_cons (EVALCAR (init_forms, env), init_values); |
2172 |
env = EXTEND_ENV (SCM_CAR (x), t.arg1, env); |
init_forms = SCM_CDR (init_forms); |
2173 |
|
} |
2174 |
|
env = EXTEND_ENV (SCM_CAR (x), init_values, env); |
2175 |
|
} |
2176 |
x = SCM_CDDR (x); |
x = SCM_CDDR (x); |
2177 |
while (proc = SCM_CAR (x), |
{ |
2178 |
SCM_FALSEP (t.arg1 = EVALCAR (proc, env)) || SCM_NILP (t.arg1)) |
SCM test_form = SCM_CAR (x); |
2179 |
{ |
SCM body_forms = SCM_CADR (x); |
2180 |
for (proc = SCM_CADR (x); SCM_NIMP (proc); proc = SCM_CDR (proc)) |
SCM step_forms = SCM_CDDR (x); |
2181 |
|
|
2182 |
|
SCM test_result = EVALCAR (test_form, env); |
2183 |
|
|
2184 |
|
while (SCM_FALSEP (test_result) || SCM_NILP (test_result)) |
2185 |
|
{ |
2186 |
|
{ |
2187 |
|
/* Evaluate body forms. */ |
2188 |
|
SCM temp_forms; |
2189 |
|
for (temp_forms = body_forms; |
2190 |
|
!SCM_NULLP (temp_forms); |
2191 |
|
temp_forms = SCM_CDR (temp_forms)) |
2192 |
|
{ |
2193 |
|
SCM form = SCM_CAR (temp_forms); |
2194 |
|
/* Dirk:FIXME: We only need to eval forms, that may have a |
2195 |
|
* side effect here. This is only true for forms that start |
2196 |
|
* with a pair. All others are just constants. However, |
2197 |
|
* since in the common case there is no constant expression |
2198 |
|
* in a body of a do form, we just check for immediates here |
2199 |
|
* and have SCM_CEVAL take care of other cases. In the long |
2200 |
|
* run it would make sense to get rid of this test and have |
2201 |
|
* the macro transformer of 'do' eliminate all forms that |
2202 |
|
* have no sideeffect. */ |
2203 |
|
if (!SCM_IMP (form)) |
2204 |
|
SCM_CEVAL (form, env); |
2205 |
|
} |
2206 |
|
} |
2207 |
|
|
2208 |
{ |
{ |
2209 |
t.arg1 = SCM_CAR (proc); /* body */ |
/* Evaluate the step expressions. */ |
2210 |
SIDEVAL (t.arg1, env); |
SCM temp_forms; |
2211 |
|
SCM step_values = SCM_EOL; |
2212 |
|
for (temp_forms = step_forms; |
2213 |
|
!SCM_NULLP (temp_forms); |
2214 |
|
temp_forms = SCM_CDR (temp_forms)) |
2215 |
|
{ |
2216 |
|
SCM value = EVALCAR (temp_forms, env); |
2217 |
|
step_values = scm_cons (value, step_values); |
2218 |
|
} |
2219 |
|
env = EXTEND_ENV (SCM_CAAR (env), step_values, SCM_CDR (env)); |
2220 |
} |
} |
2221 |
for (t.arg1 = SCM_EOL, proc = SCM_CDDR (x); |
|
2222 |
SCM_NIMP (proc); |
test_result = EVALCAR (test_form, env); |
2223 |
proc = SCM_CDR (proc)) |
} |
2224 |
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); /* steps */ |
} |
2225 |
env = EXTEND_ENV (SCM_CAAR (env), t.arg1, SCM_CDR (env)); |
x = SCM_CDAR (x); |
|
} |
|
|
x = SCM_CDR (proc); |
|
2226 |
if (SCM_NULLP (x)) |
if (SCM_NULLP (x)) |
2227 |
RETURN (SCM_UNSPECIFIED); |
RETURN (SCM_UNSPECIFIED); |
2228 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |