/[guile]/guile/guile-core/libguile/gsubr.c
ViewVC logotype

Diff of /guile/guile-core/libguile/gsubr.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.43 by dirk, Fri Aug 31 12:13:50 2001 UTC revision 1.44 by ttn, Sat Feb 9 00:38:43 2002 UTC
# Line 1  Line 1 
1  /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.  /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 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
5   * the Free Software Foundation; either version 2, or (at your option)   * the Free Software Foundation; either version 2, or (at your option)
6   * any later version.   * any later version.
7   *   *
8   * This program is distributed in the hope that it will be useful,   * This program is distributed in the hope that it will be useful,
9   * but WITHOUT ANY WARRANTY; without even the implied warranty of   * but WITHOUT ANY WARRANTY; without even the implied warranty of
10   * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11   * GNU General Public License for more details.   * GNU General Public License for more details.
12   *   *
13   * You should have received a copy of the GNU General Public License   * You should have received a copy of the GNU General Public License
14   * along with this software; see the file COPYING.  If not, write to   * along with this software; see the file COPYING.  If not, write to
15   * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,   * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
# Line 62  SCM_GLOBAL_SYMBOL (scm_sym_name, "name") Line 62  SCM_GLOBAL_SYMBOL (scm_sym_name, "name")
62  SCM scm_f_gsubr_apply;  SCM scm_f_gsubr_apply;
63    
64  static SCM  static SCM
65  create_gsubr (int define, const char *name,  create_gsubr (int define, const char *name,
66                int req, int opt, int rst, SCM (*fcn)())                int req, int opt, int rst, SCM (*fcn)())
67  {  {
68    SCM subr;    SCM subr;
# Line 103  create_gsubr (int define, const char *na Line 103  create_gsubr (int define, const char *na
103          SCM sym = SCM_SUBR_ENTRY(subr).name;          SCM sym = SCM_SUBR_ENTRY(subr).name;
104          if (SCM_GSUBR_MAX < req + opt + rst)          if (SCM_GSUBR_MAX < req + opt + rst)
105            {            {
106              fputs ("ERROR in scm_c_make_gsubr: too many args\n", stderr);              fprintf (stderr,
107                         "ERROR in scm_c_make_gsubr: too many args (%d) to %s\n",
108                         req + opt + rst, name);
109              exit (1);              exit (1);
110            }            }
111          SCM_SET_GSUBR_PROC (cclo, subr);          SCM_SET_GSUBR_PROC (cclo, subr);
# Line 215  scm_gsubr_apply (SCM args) Line 217  scm_gsubr_apply (SCM args)
217    long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);    long i, n = SCM_GSUBR_REQ (typ) + SCM_GSUBR_OPT (typ) + SCM_GSUBR_REST (typ);
218  #if 0  #if 0
219    if (n > SCM_GSUBR_MAX)    if (n > SCM_GSUBR_MAX)
220      scm_misc_error (FUNC_NAME,      scm_misc_error (FUNC_NAME,
221                      "Function ~S has illegal arity ~S.",                      "Function ~S has illegal arity ~S.",
222                      scm_list_2 (self, SCM_MAKINUM (n)));                      scm_list_2 (self, SCM_MAKINUM (n)));
223  #endif  #endif
224    args = SCM_CDR (args);    args = SCM_CDR (args);
# Line 258  scm_gsubr_apply (SCM args) Line 260  scm_gsubr_apply (SCM args)
260    
261  #ifdef GSUBR_TEST  #ifdef GSUBR_TEST
262  /* A silly example, taking 2 required args, 1 optional, and  /* A silly example, taking 2 required args, 1 optional, and
263     a scm_list of rest args     a scm_list of rest args
264     */     */
265  SCM  SCM
266  gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst)  gsubr_21l(SCM req1, SCM req2, SCM opt, SCM rst)

Legend:
Removed from v.1.43  
changed lines
  Added in v.1.44

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