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
18 #ifdef HAVE_CONFIG_H
19 # include <config.h>
20 #endif
21
22
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
gh_new_procedure(const char * proc_name,SCM (* fn)(),int n_required_args,int n_optional_args,int varp)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
gh_new_procedure0_0(const char * proc_name,SCM (* fn)())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
gh_new_procedure0_1(const char * proc_name,SCM (* fn)())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
gh_new_procedure0_2(const char * proc_name,SCM (* fn)())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
gh_new_procedure1_0(const char * proc_name,SCM (* fn)())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
gh_new_procedure1_1(const char * proc_name,SCM (* fn)())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
gh_new_procedure1_2(const char * proc_name,SCM (* fn)())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
gh_new_procedure2_0(const char * proc_name,SCM (* fn)())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
gh_new_procedure2_1(const char * proc_name,SCM (* fn)())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
gh_new_procedure2_2(const char * proc_name,SCM (* fn)())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
gh_new_procedure3_0(const char * proc_name,SCM (* fn)())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
gh_new_procedure4_0(const char * proc_name,SCM (* fn)())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
gh_new_procedure5_0(const char * proc_name,SCM (* fn)())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
gh_define(const char * name,SCM val)112 gh_define (const char *name, SCM val)
113 {
114 scm_c_define (name, val);
115 return SCM_UNSPECIFIED;
116 }
117
118
119 /* Calling Scheme functions from C. */
120
121 SCM
gh_apply(SCM proc,SCM args)122 gh_apply (SCM proc, SCM args)
123 {
124 return scm_apply (proc, args, SCM_EOL);
125 }
126
127 SCM
gh_call0(SCM proc)128 gh_call0 (SCM proc)
129 {
130 return scm_apply (proc, SCM_EOL, SCM_EOL);
131 }
132
133 SCM
gh_call1(SCM proc,SCM arg)134 gh_call1 (SCM proc, SCM arg)
135 {
136 return scm_apply (proc, arg, scm_listofnull);
137 }
138
139 SCM
gh_call2(SCM proc,SCM arg1,SCM arg2)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
gh_call3(SCM proc,SCM arg1,SCM arg2,SCM arg3)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 */
158