/[guile]/guile/guile-core/libguile/eval.c
ViewVC logotype

Diff of /guile/guile-core/libguile/eval.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.257 by dirk, Sat Mar 2 11:50:01 2002 UTC revision 1.258 by dirk, Sat Mar 2 12:47:45 2002 UTC
# Line 2003  dispatch: Line 2003  dispatch:
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);
# Line 2085  dispatch: Line 2085  dispatch:
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);
# Line 2229  dispatch: Line 2229  dispatch:
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);
# Line 2289  dispatch: Line 2302  dispatch:
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          {          {
# Line 2303  dispatch: Line 2316  dispatch:
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);

Legend:
Removed from v.1.257  
changed lines
  Added in v.1.258

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26