4.6 apply (xleval.c)

�g��������apply���Cxapply���������C �������g��xlapply�������o�����������D

/* xapply - the built-in function 'apply' */
LVAL xapply()
{
  LVAL fun,arglist;
  
  /* get the function and argument list */
  fun = xlgetarg();
  arglist = xlgalist();
  xllastarg();
  
  /* apply the function to the arguments */
  return (xlapply(pushargs(fun,arglist)));
}

xlapply���������������������������D

LVAL xlapply(argc)
     int argc;
{
  LVAL *oldargv,fun,val;
  int oldargc;
  
  /* get the function */
  fun = xlfp[1];
  
  /* get the functional value of symbols */
  if (symbolp(fun)) {
    while ((val = getfunction(fun)) == s_unbound)
      xlfunbound(fun);
    fun = xlfp[1] = val;
  }
  
  /* check for nil */
  if (null(fun))
    xlerror("bad function",fun);
  
  /* dispatch on node type */
  switch (ntype(fun)) {
  case SUBR:
    oldargc = xlargc;
    oldargv = xlargv;
    xlargc = argc;
    xlargv = xlfp + 3;
    val = (*getsubr(fun))();
    xlargc = oldargc;
    xlargv = oldargv;
    break;
  case CONS:
    if (!consp(cdr(fun)))
      xlerror("bad function",fun);
    if (car(fun) == s_lambda)
      fun = xlclose(NIL,
                    s_lambda,
                    car(cdr(fun)),
                    cdr(cdr(fun)),
                    xlenv,xlfenv);
    else
      xlerror("bad function",fun);
    /**** fall through into the next case ****/
  case CLOSURE:
    if (gettype(fun) != s_lambda)
      xlerror("bad function",fun);
    val = evfun(fun,argc,xlfp+3);
    break;
  default:
    xlerror("bad function",fun);
  }
  
  /* remove the call frame */
  xlsp = xlfp;
  xlfp = xlfp - (int)getfixnum(*xlfp);
  
  /* return the function value */
  return (val);
}