/[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.284 by mdj, Sun Dec 29 09:54:26 2002 UTC revision 1.285 by mdj, Thu Jan 23 16:04:37 2003 UTC
# Line 1  Line 1 
1  /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation, Inc.  /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002, 2003 Free Software Foundation, Inc.
2   *   *
3   * This program is free software; you can redistribute it and/or modify   * This program is free software; you can redistribute it and/or modify
4   * it under the terms of the GNU General Public License as published by   * it under the terms of the GNU General Public License as published by
# Line 80  char *alloca (); Line 80  char *alloca ();
80  #include "libguile/alist.h"  #include "libguile/alist.h"
81  #include "libguile/eq.h"  #include "libguile/eq.h"
82  #include "libguile/continuations.h"  #include "libguile/continuations.h"
83    #include "libguile/futures.h"
84  #include "libguile/throw.h"  #include "libguile/throw.h"
85  #include "libguile/smob.h"  #include "libguile/smob.h"
86  #include "libguile/macros.h"  #include "libguile/macros.h"
# Line 3803  ret: Line 3804  ret:
3804   */   */
3805    
3806  static SCM  static SCM
3807    call_subr0_0 (SCM proc)
3808    {
3809      return SCM_SUBRF (proc) ();
3810    }
3811    
3812    static SCM
3813    call_subr1o_0 (SCM proc)
3814    {
3815      return SCM_SUBRF (proc) (SCM_UNDEFINED);
3816    }
3817    
3818    static SCM
3819    call_lsubr_0 (SCM proc)
3820    {
3821      return SCM_SUBRF (proc) (SCM_EOL);
3822    }
3823    
3824    SCM
3825    scm_i_call_closure_0 (SCM proc)
3826    {
3827      return scm_eval_body (SCM_CLOSURE_BODY (proc),
3828                            SCM_EXTEND_ENV (SCM_CLOSURE_FORMALS (proc),
3829                                            SCM_EOL,
3830                                            SCM_ENV (proc)));
3831    }
3832    
3833    scm_t_trampoline_0
3834    scm_trampoline_0 (SCM proc)
3835    {
3836      if (SCM_IMP (proc))
3837        return 0;
3838      if (SCM_DEBUGGINGP)
3839        return scm_call_0;
3840      switch (SCM_TYP7 (proc))
3841        {
3842        case scm_tc7_subr_0:
3843          return call_subr0_0;
3844        case scm_tc7_subr_1o:
3845          return call_subr1o_0;
3846        case scm_tc7_lsubr:
3847          return call_lsubr_0;
3848        case scm_tcs_closures:
3849          {
3850            SCM formals = SCM_CLOSURE_FORMALS (proc);
3851            if (SCM_NULLP (formals) || SCM_SYMBOLP (formals))
3852              return scm_i_call_closure_0;
3853            else
3854              return 0;
3855          }
3856        case scm_tcs_struct:
3857          if (SCM_OBJ_CLASS_FLAGS (proc) & SCM_CLASSF_PURE_GENERIC)
3858            return scm_call_generic_0;
3859          else if (!SCM_I_OPERATORP (proc))
3860            return 0;
3861          return scm_call_0;
3862        case scm_tc7_smob:
3863          if (SCM_SMOB_APPLICABLE_P (proc))
3864            return SCM_SMOB_DESCRIPTOR (proc).apply_0;
3865          else
3866            return 0;
3867          /* fall through */
3868        case scm_tc7_asubr:
3869        case scm_tc7_rpsubr:
3870        case scm_tc7_cclo:
3871        case scm_tc7_pws:
3872          return scm_call_0;
3873        default:
3874          return 0; /* not applicable on one arg */
3875        }
3876    }
3877    
3878    static SCM
3879  call_subr1_1 (SCM proc, SCM arg1)  call_subr1_1 (SCM proc, SCM arg1)
3880  {  {
3881    return SCM_SUBRF (proc) (arg1);    return SCM_SUBRF (proc) (arg1);
# Line 3888  scm_trampoline_1 (SCM proc) Line 3961  scm_trampoline_1 (SCM proc)
3961      case scm_tcs_closures:      case scm_tcs_closures:
3962        {        {
3963          SCM formals = SCM_CLOSURE_FORMALS (proc);          SCM formals = SCM_CLOSURE_FORMALS (proc);
3964          if (!SCM_CONSP (formals) || SCM_NULLP (SCM_CDR (formals)))          if ((SCM_CONSP (formals) && SCM_NULLP (SCM_CDR (formals)))
3965                || SCM_SYMBOLP (formals))
3966            return call_closure_1;            return call_closure_1;
3967          else          else
3968            return 0;            return 0;

Legend:
Removed from v.1.284  
changed lines
  Added in v.1.285

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