/[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.256 by dirk, Sat Mar 2 09:53:51 2002 UTC revision 1.257 by dirk, Sat Mar 2 11:50:01 2002 UTC
# Line 2121  dispatch: Line 2121  dispatch:
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);

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

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