2003 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2004 |
while (!SCM_NULLP (SCM_CDR (x))) |
while (!SCM_NULLP (SCM_CDR (x))) |
2005 |
{ |
{ |
2006 |
SCM condition = EVALCAR (x, env); |
SCM test_result = EVALCAR (x, env); |
2007 |
if (SCM_FALSEP (condition) || SCM_NILP (condition)) |
if (SCM_FALSEP (test_result) || SCM_NILP (test_result)) |
2008 |
RETURN (SCM_BOOL_F); |
RETURN (SCM_BOOL_F); |
2009 |
else |
else |
2010 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2085 |
} |
} |
2086 |
|
|
2087 |
|
|
2088 |
case SCM_BIT8(SCM_IM_CASE): |
case SCM_BIT8 (SCM_IM_CASE): |
2089 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2090 |
{ |
{ |
2091 |
SCM key = EVALCAR (x, env); |
SCM key = EVALCAR (x, env); |
2229 |
goto nontoplevel_begin; |
goto nontoplevel_begin; |
2230 |
|
|
2231 |
|
|
2232 |
case SCM_BIT8(SCM_IM_IF): |
case SCM_BIT8 (SCM_IM_IF): |
2233 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2234 |
if (!SCM_FALSEP (t.arg1 = EVALCAR (x, env)) && !SCM_NILP (t.arg1)) |
{ |
2235 |
x = SCM_CDR (x); |
SCM test_result = EVALCAR (x, env); |
2236 |
else if (SCM_IMP (x = SCM_CDDR (x))) |
if (!SCM_FALSEP (test_result) && !SCM_NILP (test_result)) |
2237 |
RETURN (SCM_UNSPECIFIED); |
x = SCM_CDR (x); |
2238 |
|
else |
2239 |
|
{ |
2240 |
|
x = SCM_CDDR (x); |
2241 |
|
if (SCM_NULLP (x)) |
2242 |
|
RETURN (SCM_UNSPECIFIED); |
2243 |
|
} |
2244 |
|
} |
2245 |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
PREP_APPLY (SCM_UNDEFINED, SCM_EOL); |
2246 |
goto carloop; |
goto carloop; |
2247 |
|
|
2248 |
|
|
2249 |
case SCM_BIT8(SCM_IM_LET): |
case SCM_BIT8 (SCM_IM_LET): |
2250 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2251 |
proc = SCM_CADR (x); |
{ |
2252 |
t.arg1 = SCM_EOL; |
SCM init_forms = SCM_CADR (x); |
2253 |
do |
SCM init_values = SCM_EOL; |
2254 |
{ |
do |
2255 |
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); |
{ |
2256 |
} |
init_values = scm_cons (EVALCAR (init_forms, env), init_values); |
2257 |
while (SCM_NIMP (proc = SCM_CDR (proc))); |
init_forms = SCM_CDR (init_forms); |
2258 |
env = EXTEND_ENV (SCM_CAR (x), t.arg1, env); |
} |
2259 |
|
while (!SCM_NULLP (init_forms)); |
2260 |
|
env = EXTEND_ENV (SCM_CAR (x), init_values, env); |
2261 |
|
} |
2262 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2263 |
goto nontoplevel_cdrxnoap; |
goto nontoplevel_cdrxnoap; |
2264 |
|
|
2265 |
|
|
2266 |
case SCM_BIT8(SCM_IM_LETREC): |
case SCM_BIT8 (SCM_IM_LETREC): |
2267 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2268 |
env = EXTEND_ENV (SCM_CAR (x), scm_undefineds, env); |
env = EXTEND_ENV (SCM_CAR (x), scm_undefineds, env); |
2269 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2270 |
proc = SCM_CAR (x); |
{ |
2271 |
t.arg1 = SCM_EOL; |
SCM init_forms = SCM_CAR (x); |
2272 |
do |
SCM init_values = SCM_EOL; |
2273 |
{ |
do |
2274 |
t.arg1 = scm_cons (EVALCAR (proc, env), t.arg1); |
{ |
2275 |
} |
init_values = scm_cons (EVALCAR (init_forms, env), init_values); |
2276 |
while (SCM_NIMP (proc = SCM_CDR (proc))); |
init_forms = SCM_CDR (init_forms); |
2277 |
SCM_SETCDR (SCM_CAR (env), t.arg1); |
} |
2278 |
|
while (!SCM_NULLP (init_forms)); |
2279 |
|
SCM_SETCDR (SCM_CAR (env), init_values); |
2280 |
|
} |
2281 |
goto nontoplevel_cdrxnoap; |
goto nontoplevel_cdrxnoap; |
2282 |
|
|
2283 |
|
|
2284 |
case SCM_BIT8(SCM_IM_LETSTAR): |
case SCM_BIT8 (SCM_IM_LETSTAR): |
2285 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2286 |
{ |
{ |
2287 |
SCM bindings = SCM_CAR (x); |
SCM bindings = SCM_CAR (x); |
2302 |
goto nontoplevel_cdrxnoap; |
goto nontoplevel_cdrxnoap; |
2303 |
|
|
2304 |
|
|
2305 |
case SCM_BIT8(SCM_IM_OR): |
case SCM_BIT8 (SCM_IM_OR): |
2306 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2307 |
while (!SCM_NULLP (SCM_CDR (x))) |
while (!SCM_NULLP (SCM_CDR (x))) |
2308 |
{ |
{ |
2316 |
goto carloop; |
goto carloop; |
2317 |
|
|
2318 |
|
|
2319 |
case SCM_BIT8(SCM_IM_LAMBDA): |
case SCM_BIT8 (SCM_IM_LAMBDA): |
2320 |
RETURN (scm_closure (SCM_CDR (x), env)); |
RETURN (scm_closure (SCM_CDR (x), env)); |
2321 |
|
|
2322 |
|
|
2323 |
case SCM_BIT8(SCM_IM_QUOTE): |
case SCM_BIT8 (SCM_IM_QUOTE): |
2324 |
RETURN (SCM_CADR (x)); |
RETURN (SCM_CADR (x)); |
2325 |
|
|
2326 |
|
|
2327 |
case SCM_BIT8(SCM_IM_SET_X): |
case SCM_BIT8 (SCM_IM_SET_X): |
2328 |
x = SCM_CDR (x); |
x = SCM_CDR (x); |
2329 |
proc = SCM_CAR (x); |
{ |
2330 |
switch (SCM_ITAG3 (proc)) |
SCM *location; |
2331 |
{ |
SCM variable = SCM_CAR (x); |
2332 |
case scm_tc3_cons: |
if (SCM_VARIABLEP (variable)) |
2333 |
if (SCM_VARIABLEP (proc)) |
location = SCM_VARIABLE_LOC (variable); |
|
t.lloc = SCM_VARIABLE_LOC (proc); |
|
|
else |
|
|
t.lloc = scm_lookupcar (x, env, 1); |
|
|
break; |
|
2334 |
#ifdef MEMOIZE_LOCALS |
#ifdef MEMOIZE_LOCALS |
2335 |
case scm_tc3_imm24: |
else if (SCM_ILOCP (variable)) |
2336 |
t.lloc = scm_ilookup (proc, env); |
location = scm_ilookup (variable, env); |
|
break; |
|
2337 |
#endif |
#endif |
2338 |
} |
else /* (SCM_SYMBOLP (variable)) is known to be true */ |
2339 |
x = SCM_CDR (x); |
location = scm_lookupcar (x, env, 1); |
2340 |
*t.lloc = EVALCAR (x, env); |
x = SCM_CDR (x); |
2341 |
#ifdef SICP |
*location = EVALCAR (x, env); |
2342 |
RETURN (*t.lloc); |
} |
|
#else |
|
2343 |
RETURN (SCM_UNSPECIFIED); |
RETURN (SCM_UNSPECIFIED); |
|
#endif |
|
2344 |
|
|
2345 |
|
|
2346 |
case SCM_BIT8(SCM_IM_DEFINE): /* only for internal defines */ |
case SCM_BIT8(SCM_IM_DEFINE): /* only for internal defines */ |
2347 |
scm_misc_error (NULL, "Bad define placement", SCM_EOL); |
scm_misc_error (NULL, "Bad define placement", SCM_EOL); |
2348 |
|
|
2349 |
|
|
2350 |
/* new syntactic forms go here. */ |
/* new syntactic forms go here. */ |
2351 |
case SCM_BIT8(SCM_MAKISYM (0)): |
case SCM_BIT8(SCM_MAKISYM (0)): |
2352 |
proc = SCM_CAR (x); |
proc = SCM_CAR (x); |