guile18/libguile/gh_funcs.c

   1 /*      Copyright (C) 1995,1996,1997,1998, 2000, 2001, 2006, 2008 Free Software Foundation, Inc.
   2
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17 \f
  18 #ifdef HAVE_CONFIG_H
  19 # include <config.h>
  20 #endif
  21
  22 \f
  23 /* Defining Scheme functions implemented by C functions --- subrs.  */
  24
  25 #include "libguile/gh.h"
  26
  27 #if SCM_ENABLE_DEPRECATED
  28
  29 /* allows you to define new scheme primitives written in C */
  30 SCM
  31 gh_new_procedure (const char *proc_name, SCM (*fn) (),
  32                   int n_required_args, int n_optional_args, int varp)
  33 {
  34   return scm_c_define_gsubr (proc_name, n_required_args, n_optional_args,
  35                              varp, fn);
  36 }
  37
  38 SCM
  39 gh_new_procedure0_0 (const char *proc_name, SCM (*fn) ())
  40 {
  41   return gh_new_procedure (proc_name, fn, 0, 0, 0);
  42 }
  43
  44 SCM
  45 gh_new_procedure0_1 (const char *proc_name, SCM (*fn) ())
  46 {
  47   return gh_new_procedure (proc_name, fn, 0, 1, 0);
  48 }
  49
  50 SCM
  51 gh_new_procedure0_2 (const char *proc_name, SCM (*fn) ())
  52 {
  53   return gh_new_procedure (proc_name, fn, 0, 2, 0);
  54 }
  55
  56 SCM
  57 gh_new_procedure1_0 (const char *proc_name, SCM (*fn) ())
  58 {
  59   return gh_new_procedure (proc_name, fn, 1, 0, 0);
  60 }
  61
  62 SCM
  63 gh_new_procedure1_1 (const char *proc_name, SCM (*fn) ())
  64 {
  65   return gh_new_procedure (proc_name, fn, 1, 1, 0);
  66 }
  67
  68 SCM
  69 gh_new_procedure1_2 (const char *proc_name, SCM (*fn) ())
  70 {
  71   return gh_new_procedure (proc_name, fn, 1, 2, 0);
  72 }
  73
  74 SCM
  75 gh_new_procedure2_0 (const char *proc_name, SCM (*fn) ())
  76 {
  77   return gh_new_procedure (proc_name, fn, 2, 0, 0);
  78 }
  79
  80 SCM
  81 gh_new_procedure2_1 (const char *proc_name, SCM (*fn) ())
  82 {
  83   return gh_new_procedure (proc_name, fn, 2, 1, 0);
  84 }
  85
  86 SCM
  87 gh_new_procedure2_2 (const char *proc_name, SCM (*fn) ())
  88 {
  89   return gh_new_procedure (proc_name, fn, 2, 2, 0);
  90 }
  91
  92 SCM
  93 gh_new_procedure3_0 (const char *proc_name, SCM (*fn) ())
  94 {
  95   return gh_new_procedure (proc_name, fn, 3, 0, 0);
  96 }
  97
  98 SCM
  99 gh_new_procedure4_0 (const char *proc_name, SCM (*fn) ())
 100 {
 101   return gh_new_procedure (proc_name, fn, 4, 0, 0);
 102 }
 103
 104 SCM
 105 gh_new_procedure5_0 (const char *proc_name, SCM (*fn) ())
 106 {
 107   return gh_new_procedure (proc_name, fn, 5, 0, 0);
 108 }
 109
 110 /* some (possibly most) Scheme functions available from C */
 111 SCM
 112 gh_define (const char *name, SCM val)
 113 {
 114   scm_c_define (name, val);
 115   return SCM_UNSPECIFIED;
 116 }
 117
 118 \f
 119 /* Calling Scheme functions from C.  */
 120
 121 SCM
 122 gh_apply (SCM proc, SCM args)
 123 {
 124   return scm_apply (proc, args, SCM_EOL);
 125 }
 126
 127 SCM
 128 gh_call0 (SCM proc)
 129 {
 130   return scm_apply (proc, SCM_EOL, SCM_EOL);
 131 }
 132
 133 SCM
 134 gh_call1 (SCM proc, SCM arg)
 135 {
 136   return scm_apply (proc, arg, scm_listofnull);
 137 }
 138
 139 SCM
 140 gh_call2 (SCM proc, SCM arg1, SCM arg2)
 141 {
 142   return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull));
 143 }
 144
 145 SCM
 146 gh_call3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
 147 {
 148   return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
 149 }
 150
 151 #endif /* SCM_ENABLE_DEPRECATED */
 152
 153 /*
 154   Local Variables:
 155   c-file-style: "gnu"
 156   End:
 157 */