/[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.258 by dirk, Sat Mar 2 12:47:45 2002 UTC revision 1.259 by dirk, Tue Mar 5 21:10:15 2002 UTC
# Line 2348  dispatch: Line 2348  dispatch:
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);
2353        SCM_ASRTGO (SCM_ISYMP (proc), badfun);        SCM_ASRTGO (SCM_ISYMP (proc), badfun);
2354        switch (SCM_ISYMNUM (proc))        switch (SCM_ISYMNUM (proc))
2355          {          {
2356    
2357    
2358          case (SCM_ISYMNUM (SCM_IM_APPLY)):          case (SCM_ISYMNUM (SCM_IM_APPLY)):
2359            proc = SCM_CDR (x);            proc = SCM_CDR (x);
2360            proc = EVALCAR (proc, env);            proc = EVALCAR (proc, env);
2361            SCM_ASRTGO (SCM_NIMP (proc), badfun);            SCM_ASRTGO (!SCM_IMP (proc), badfun);
2362            if (SCM_CLOSUREP (proc))            if (SCM_CLOSUREP (proc))
2363              {              {
               SCM argl, tl;  
2364                PREP_APPLY (proc, SCM_EOL);                PREP_APPLY (proc, SCM_EOL);
2365                t.arg1 = SCM_CDDR (x);                t.arg1 = SCM_CDDR (x);
2366                t.arg1 = EVALCAR (t.arg1, env);                t.arg1 = EVALCAR (t.arg1, env);
# Line 2367  dispatch: Line 2368  dispatch:
2368                /* Go here to tail-call a closure.  PROC is the closure                /* Go here to tail-call a closure.  PROC is the closure
2369                   and T.ARG1 is the list of arguments.  Do not forget to                   and T.ARG1 is the list of arguments.  Do not forget to
2370                   call PREP_APPLY. */                   call PREP_APPLY. */
2371                  {
2372                    SCM formals = SCM_CLOSURE_FORMALS (proc);
2373  #ifdef DEVAL  #ifdef DEVAL
2374                debug.info->a.args = t.arg1;                  debug.info->a.args = t.arg1;
2375  #endif  #endif
2376  #ifndef SCM_RECKLESS  #ifndef SCM_RECKLESS
2377                if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), t.arg1))                  if (scm_badargsp (formals, t.arg1))
2378                  goto wrongnumargs;                    goto wrongnumargs;
2379  #endif  #endif
2380                ENTER_APPLY;                  ENTER_APPLY;
2381                /* Copy argument list */                  /* Copy argument list */
2382                if (SCM_IMP (t.arg1))                  if (SCM_NULL_OR_NIL_P (t.arg1))
2383                  argl = t.arg1;                    env = EXTEND_ENV (formals, SCM_EOL, SCM_ENV (proc));
2384                else                  else
2385                  {                    {
2386                    argl = tl = scm_cons (SCM_CAR (t.arg1), SCM_UNSPECIFIED);                      SCM args = scm_list_1 (SCM_CAR (t.arg1));
2387                    while (SCM_NIMP (t.arg1 = SCM_CDR (t.arg1))                      SCM tail = args;
2388                           && SCM_CONSP (t.arg1))                      t.arg1 = SCM_CDR (t.arg1);
2389                      {                      while (!SCM_NULL_OR_NIL_P (t.arg1))
2390                        SCM_SETCDR (tl, scm_cons (SCM_CAR (t.arg1),                        {
2391                                                  SCM_UNSPECIFIED));                          SCM new_tail = scm_list_1 (SCM_CAR (t.arg1));
2392                        tl = SCM_CDR (tl);                          SCM_SETCDR (tail, new_tail);
2393                      }                          tail = new_tail;
2394                    SCM_SETCDR (tl, t.arg1);                          t.arg1 = SCM_CDR (t.arg1);
2395                  }                        }
2396                        env = EXTEND_ENV (formals, args, SCM_ENV (proc));
2397                      }
2398                                
2399                env = EXTEND_ENV (SCM_CLOSURE_FORMALS (proc), argl, SCM_ENV (proc));                  x = SCM_CLOSURE_BODY (proc);
2400                x = SCM_CLOSURE_BODY (proc);                  goto nontoplevel_begin;
2401                goto nontoplevel_begin;                }
2402              }              }
2403            proc = scm_f_apply;            else
2404            goto evapply;              {
2405                  proc = scm_f_apply;
2406                  goto evapply;
2407                }
2408    
2409    
2410          case (SCM_ISYMNUM (SCM_IM_CONT)):          case (SCM_ISYMNUM (SCM_IM_CONT)):
2411            {            {

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

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