/[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.277 by dirk, Mon Jul 15 20:39:53 2002 UTC revision 1.278 by xxhanwen, Sat Jul 20 14:08:33 2002 UTC
# Line 798  iqq (SCM form, SCM env, unsigned long in Line 798  iqq (SCM form, SCM env, unsigned long in
798    else if (SCM_VECTORP (form))    else if (SCM_VECTORP (form))
799      {      {
800        size_t i = SCM_VECTOR_LENGTH (form);        size_t i = SCM_VECTOR_LENGTH (form);
801        SCM *data = SCM_VELTS (form);        SCM const *data = SCM_VELTS (form);
802        SCM tmp = SCM_EOL;        SCM tmp = SCM_EOL;
803        while (i != 0)        while (i != 0)
804          tmp = scm_cons (data[--i], tmp);          tmp = scm_cons (data[--i], tmp);
# Line 1020  scm_m_let (SCM xorig, SCM env) Line 1020  scm_m_let (SCM xorig, SCM env)
1020  }  }
1021    
1022    
1023  SCM_SYNTAX (s_atapply,"@apply", scm_makmmacro, scm_m_apply);  SCM_SYNTAX (s_atapply, "@apply", scm_makmmacro, scm_m_apply);
1024  SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);  SCM_GLOBAL_SYMBOL (scm_sym_atapply, s_atapply);
1025  SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);  SCM_GLOBAL_SYMBOL (scm_sym_apply, s_atapply + 1);
1026    
# Line 1032  scm_m_apply (SCM xorig, SCM env SCM_UNUS Line 1032  scm_m_apply (SCM xorig, SCM env SCM_UNUS
1032  }  }
1033    
1034    
1035  SCM_SYNTAX(s_atcall_cc,"@call-with-current-continuation", scm_makmmacro, scm_m_cont);  SCM_SYNTAX(s_atcall_cc, "@call-with-current-continuation", scm_makmmacro, scm_m_cont);
1036  SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc,s_atcall_cc);  SCM_GLOBAL_SYMBOL(scm_sym_atcall_cc, s_atcall_cc);
1037    
1038    
1039  SCM  SCM
# Line 3413  SCM_DEFINE (scm_nconc2last, "apply:nconc Line 3413  SCM_DEFINE (scm_nconc2last, "apply:nconc
3413  #define FUNC_NAME s_scm_nconc2last  #define FUNC_NAME s_scm_nconc2last
3414  {  {
3415    SCM *lloc;    SCM *lloc;
3416    SCM_VALIDATE_NONEMPTYLIST (1,lst);    SCM_VALIDATE_NONEMPTYLIST (1, lst);
3417    lloc = &lst;    lloc = &lst;
3418    while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be    while (!SCM_NULLP (SCM_CDR (*lloc))) /* Perhaps should be
3419                                            SCM_NULL_OR_NIL_P, but not                                            SCM_NULL_OR_NIL_P, but not
# Line 3792  check_map_args (SCM argv, Line 3792  check_map_args (SCM argv,
3792                  SCM args,                  SCM args,
3793                  const char *who)                  const char *who)
3794  {  {
3795    SCM *ve = SCM_VELTS (argv);    SCM const *ve = SCM_VELTS (argv);
3796    long i;    long i;
3797    
3798    for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)    for (i = SCM_VECTOR_LENGTH (argv) - 1; i >= 1; i--)
# Line 3831  scm_map (SCM proc, SCM arg1, SCM args) Line 3831  scm_map (SCM proc, SCM arg1, SCM args)
3831    long i, len;    long i, len;
3832    SCM res = SCM_EOL;    SCM res = SCM_EOL;
3833    SCM *pres = &res;    SCM *pres = &res;
3834    SCM *ve = &args;              /* Keep args from being optimized away. */    SCM const *ve = &args;                /* Keep args from being optimized away. */
3835    
3836    len = scm_ilength (arg1);    len = scm_ilength (arg1);
3837    SCM_GASSERTn (len >= 0,    SCM_GASSERTn (len >= 0,
# Line 3858  scm_map (SCM proc, SCM arg1, SCM args) Line 3858  scm_map (SCM proc, SCM arg1, SCM args)
3858            if (SCM_IMP (ve[i]))            if (SCM_IMP (ve[i]))
3859              return res;              return res;
3860            arg1 = scm_cons (SCM_CAR (ve[i]), arg1);            arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
3861            ve[i] = SCM_CDR (ve[i]);            SCM_VECTOR_SET (args, i, SCM_CDR (ve[i]));
3862          }          }
3863        *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));        *pres = scm_list_1 (scm_apply (proc, arg1, SCM_EOL));
3864        pres = SCM_CDRLOC (*pres);        pres = SCM_CDRLOC (*pres);
# Line 3873  SCM Line 3873  SCM
3873  scm_for_each (SCM proc, SCM arg1, SCM args)  scm_for_each (SCM proc, SCM arg1, SCM args)
3874  #define FUNC_NAME s_for_each  #define FUNC_NAME s_for_each
3875  {  {
3876    SCM *ve = &args;              /* Keep args from being optimized away. */    SCM const *ve = &args;                /* Keep args from being optimized away. */
3877    long i, len;    long i, len;
3878    len = scm_ilength (arg1);    len = scm_ilength (arg1);
3879    SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),    SCM_GASSERTn (len >= 0, g_for_each, scm_cons2 (proc, arg1, args),
# Line 3899  scm_for_each (SCM proc, SCM arg1, SCM ar Line 3899  scm_for_each (SCM proc, SCM arg1, SCM ar
3899            if (SCM_IMP (ve[i]))            if (SCM_IMP (ve[i]))
3900              return SCM_UNSPECIFIED;              return SCM_UNSPECIFIED;
3901            arg1 = scm_cons (SCM_CAR (ve[i]), arg1);            arg1 = scm_cons (SCM_CAR (ve[i]), arg1);
3902            ve[i] = SCM_CDR (ve[i]);            SCM_VECTOR_SET (args, i, SCM_CDR (ve[i]));
3903          }          }
3904        scm_apply (proc, arg1, SCM_EOL);        scm_apply (proc, arg1, SCM_EOL);
3905      }      }
# Line 4011  SCM_DEFINE (scm_copy_tree, "copy-tree", Line 4011  SCM_DEFINE (scm_copy_tree, "copy-tree",
4011        unsigned long i = SCM_VECTOR_LENGTH (obj);        unsigned long i = SCM_VECTOR_LENGTH (obj);
4012        ans = scm_c_make_vector (i, SCM_UNSPECIFIED);        ans = scm_c_make_vector (i, SCM_UNSPECIFIED);
4013        while (i--)        while (i--)
4014          SCM_VELTS (ans)[i] = scm_copy_tree (SCM_VELTS (obj)[i]);          SCM_VECTOR_SET (ans, i, scm_copy_tree (SCM_VELTS (obj)[i]));
4015        return ans;        return ans;
4016      }      }
4017    if (!SCM_CONSP (obj))    if (!SCM_CONSP (obj))

Legend:
Removed from v.1.277  
changed lines
  Added in v.1.278

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