/[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.268 by dirk, Thu Mar 21 00:36:03 2002 UTC revision 1.269 by dirk, Sat Mar 23 00:39:25 2002 UTC
# Line 2363  dispatch: Line 2363  dispatch:
2363  #endif  #endif
2364  #ifndef SCM_RECKLESS  #ifndef SCM_RECKLESS
2365                  if (scm_badargsp (formals, arg1))                  if (scm_badargsp (formals, arg1))
2366                    goto wrongnumargs;                    scm_wrong_num_args (proc);
2367  #endif  #endif
2368                  ENTER_APPLY;                  ENTER_APPLY;
2369                  /* Copy argument list */                  /* Copy argument list */
# Line 2903  evapply: /* inputs: x, proc */ Line 2903  evapply: /* inputs: x, proc */
2903        case scm_tc7_lsubr_2:        case scm_tc7_lsubr_2:
2904        umwrongnumargs:        umwrongnumargs:
2905          unmemocar (x, env);          unmemocar (x, env);
       wrongnumargs:  
2906          scm_wrong_num_args (proc);          scm_wrong_num_args (proc);
2907        default:        default:
2908          /* handle macros here */          /* handle macros here */
# Line 2917  evapply: /* inputs: x, proc */ Line 2916  evapply: /* inputs: x, proc */
2916    if (SCM_CONSP (x))    if (SCM_CONSP (x))
2917      arg1 = EVALCAR (x, env);      arg1 = EVALCAR (x, env);
2918    else    else
2919      goto wrongnumargs;      scm_wrong_num_args (proc);
2920  #else  #else
2921    arg1 = EVALCAR (x, env);    arg1 = EVALCAR (x, env);
2922  #endif  #endif
# Line 3043  evapply: /* inputs: x, proc */ Line 3042  evapply: /* inputs: x, proc */
3042            case scm_tc7_subr_0:            case scm_tc7_subr_0:
3043            case scm_tc7_subr_3:            case scm_tc7_subr_3:
3044            case scm_tc7_lsubr_2:            case scm_tc7_lsubr_2:
3045              goto wrongnumargs;              scm_wrong_num_args (proc);
3046            default:            default:
3047              goto badfun;              goto badfun;
3048            }            }
# Line 3052  evapply: /* inputs: x, proc */ Line 3051  evapply: /* inputs: x, proc */
3051      if (SCM_CONSP (x))      if (SCM_CONSP (x))
3052        arg2 = EVALCAR (x, env);        arg2 = EVALCAR (x, env);
3053      else      else
3054        goto wrongnumargs;        scm_wrong_num_args (proc);
3055  #else  #else
3056      arg2 = EVALCAR (x, env);      arg2 = EVALCAR (x, env);
3057  #endif  #endif
# Line 3138  evapply: /* inputs: x, proc */ Line 3137  evapply: /* inputs: x, proc */
3137            case scm_tc7_subr_1o:            case scm_tc7_subr_1o:
3138            case scm_tc7_subr_1:            case scm_tc7_subr_1:
3139            case scm_tc7_subr_3:            case scm_tc7_subr_3:
3140              goto wrongnumargs;              scm_wrong_num_args (proc);
3141            default:            default:
3142              goto badfun;              goto badfun;
3143            case scm_tc7_pws:            case scm_tc7_pws:
# Line 3166  evapply: /* inputs: x, proc */ Line 3165  evapply: /* inputs: x, proc */
3165        }        }
3166  #ifdef SCM_CAUTIOUS  #ifdef SCM_CAUTIOUS
3167        if (!SCM_CONSP (x))        if (!SCM_CONSP (x))
3168          goto wrongnumargs;          scm_wrong_num_args (proc);
3169  #endif  #endif
3170  #ifdef DEVAL  #ifdef DEVAL
3171        debug.info->a.args = scm_cons2 (arg1, arg2,        debug.info->a.args = scm_cons2 (arg1, arg2,
# Line 3179  evapply: /* inputs: x, proc */ Line 3178  evapply: /* inputs: x, proc */
3178          {                       /* have 3 or more arguments */          {                       /* have 3 or more arguments */
3179  #ifdef DEVAL  #ifdef DEVAL
3180          case scm_tc7_subr_3:          case scm_tc7_subr_3:
3181            SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs);            if (!SCM_NULLP (SCM_CDR (x)))
3182            RETURN (SCM_SUBRF (proc) (arg1, arg2,              scm_wrong_num_args (proc);
3183                                      SCM_CADDR (debug.info->a.args)));            else
3184                RETURN (SCM_SUBRF (proc) (arg1, arg2,
3185                                          SCM_CADDR (debug.info->a.args)));
3186          case scm_tc7_asubr:          case scm_tc7_asubr:
3187            arg1 = SCM_SUBRF(proc)(arg1, arg2);            arg1 = SCM_SUBRF(proc)(arg1, arg2);
3188            arg2 = SCM_CDDR (debug.info->a.args);            arg2 = SCM_CDDR (debug.info->a.args);
# Line 3233  evapply: /* inputs: x, proc */ Line 3234  evapply: /* inputs: x, proc */
3234            goto nontoplevel_begin;            goto nontoplevel_begin;
3235  #else /* DEVAL */  #else /* DEVAL */
3236          case scm_tc7_subr_3:          case scm_tc7_subr_3:
3237            SCM_ASRTGO (SCM_NULLP (SCM_CDR (x)), wrongnumargs);            if (!SCM_NULLP (SCM_CDR (x)))
3238            RETURN (SCM_SUBRF (proc) (arg1, arg2, EVALCAR (x, env)));              scm_wrong_num_args (proc);
3239              else
3240                RETURN (SCM_SUBRF (proc) (arg1, arg2, EVALCAR (x, env)));
3241          case scm_tc7_asubr:          case scm_tc7_asubr:
3242            arg1 = SCM_SUBRF (proc) (arg1, arg2);            arg1 = SCM_SUBRF (proc) (arg1, arg2);
3243            do            do
# Line 3316  evapply: /* inputs: x, proc */ Line 3319  evapply: /* inputs: x, proc */
3319          case scm_tc7_subr_0:          case scm_tc7_subr_0:
3320          case scm_tc7_cxr:          case scm_tc7_cxr:
3321          case scm_tc7_subr_1:          case scm_tc7_subr_1:
3322            goto wrongnumargs;            scm_wrong_num_args (proc);
3323          default:          default:
3324            goto badfun;            goto badfun;
3325          }          }
# Line 3583  tail: Line 3586  tail:
3586        args = SCM_NULLP (args) ? SCM_UNDEFINED : SCM_CAR (args);        args = SCM_NULLP (args) ? SCM_UNDEFINED : SCM_CAR (args);
3587        RETURN (SCM_SUBRF (proc) (arg1, args));        RETURN (SCM_SUBRF (proc) (arg1, args));
3588      case scm_tc7_subr_2:      case scm_tc7_subr_2:
3589        SCM_ASRTGO (!SCM_NULLP (args) && SCM_NULLP (SCM_CDR (args)),        if (SCM_NULLP (args) || !SCM_NULLP (SCM_CDR (args)))
3590                    wrongnumargs);          scm_wrong_num_args (proc);
3591        args = SCM_CAR (args);        args = SCM_CAR (args);
3592        RETURN (SCM_SUBRF (proc) (arg1, args));        RETURN (SCM_SUBRF (proc) (arg1, args));
3593      case scm_tc7_subr_0:      case scm_tc7_subr_0:
3594        SCM_ASRTGO (SCM_UNBNDP (arg1), wrongnumargs);        if (!SCM_UNBNDP (arg1))
3595        RETURN (SCM_SUBRF (proc) ());          scm_wrong_num_args (proc);
3596          else
3597            RETURN (SCM_SUBRF (proc) ());
3598      case scm_tc7_subr_1:      case scm_tc7_subr_1:
3599        SCM_ASRTGO (!SCM_UNBNDP (arg1), wrongnumargs);        if (SCM_UNBNDP (arg1))
3600            scm_wrong_num_args (proc);
3601      case scm_tc7_subr_1o:      case scm_tc7_subr_1o:
3602        SCM_ASRTGO (SCM_NULLP (args), wrongnumargs);        if (!SCM_NULLP (args))
3603        RETURN (SCM_SUBRF (proc) (arg1));          scm_wrong_num_args (proc);
3604          else
3605            RETURN (SCM_SUBRF (proc) (arg1));
3606      case scm_tc7_cxr:      case scm_tc7_cxr:
3607        SCM_ASRTGO (!SCM_UNBNDP (arg1) && SCM_NULLP (args), wrongnumargs);        if (SCM_UNBNDP (arg1) || !SCM_NULLP (args))
3608            scm_wrong_num_args (proc);
3609        if (SCM_SUBRF (proc))        if (SCM_SUBRF (proc))
3610          {          {
3611            if (SCM_INUMP (arg1))            if (SCM_INUMP (arg1))
# Line 3626  tail: Line 3635  tail:
3635          RETURN (arg1);          RETURN (arg1);
3636        }        }
3637      case scm_tc7_subr_3:      case scm_tc7_subr_3:
3638        SCM_ASRTGO (!SCM_NULLP (args)        if (SCM_NULLP (args)
3639                    && !SCM_NULLP (SCM_CDR (args))            || SCM_NULLP (SCM_CDR (args))
3640                    && SCM_NULLP (SCM_CDDR (args)),            || !SCM_NULLP (SCM_CDDR (args)))
3641                    wrongnumargs);          scm_wrong_num_args (proc);
3642        RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CADR (args)));        else
3643            RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CADR (args)));
3644      case scm_tc7_lsubr:      case scm_tc7_lsubr:
3645  #ifdef DEVAL  #ifdef DEVAL
3646        RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : debug.vect[0].a.args));        RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : debug.vect[0].a.args));
# Line 3638  tail: Line 3648  tail:
3648        RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)));        RETURN (SCM_SUBRF (proc) (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args)));
3649  #endif  #endif
3650      case scm_tc7_lsubr_2:      case scm_tc7_lsubr_2:
3651        SCM_ASRTGO (SCM_CONSP (args), wrongnumargs);        if (!SCM_CONSP (args))
3652        RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CDR (args)));          scm_wrong_num_args (proc);
3653          else
3654            RETURN (SCM_SUBRF (proc) (arg1, SCM_CAR (args), SCM_CDR (args)));
3655      case scm_tc7_asubr:      case scm_tc7_asubr:
3656        if (SCM_NULLP (args))        if (SCM_NULLP (args))
3657          RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));          RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED));
# Line 3670  tail: Line 3682  tail:
3682  #endif  #endif
3683  #ifndef SCM_RECKLESS  #ifndef SCM_RECKLESS
3684        if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1))        if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1))
3685          goto wrongnumargs;          scm_wrong_num_args (proc);
3686  #endif  #endif
3687                
3688        /* Copy argument list */        /* Copy argument list */
# Line 3771  tail: Line 3783  tail:
3783            else            else
3784              goto badproc;              goto badproc;
3785          }          }
     wrongnumargs:  
       scm_wrong_num_args (proc);  
3786      default:      default:
3787      badproc:      badproc:
3788        scm_wrong_type_arg ("apply", SCM_ARG1, proc);        scm_wrong_type_arg ("apply", SCM_ARG1, proc);
       RETURN (arg1);  
3789      }      }
3790  #ifdef DEVAL  #ifdef DEVAL
3791  exit:  exit:

Legend:
Removed from v.1.268  
changed lines
  Added in v.1.269

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