Commit | Line | Data |
---|---|---|
2b829bbb | 1 | /* Copyright (C) 1995,1996,1997,1998, 2000, 2001, 2006 Free Software Foundation, Inc. |
ee2a8b9b | 2 | |
73be1d9e MV |
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. | |
ee2a8b9b | 7 | * |
73be1d9e MV |
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. | |
ee2a8b9b | 12 | * |
73be1d9e MV |
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 | |
92205699 | 15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
73be1d9e | 16 | */ |
ee2a8b9b JB |
17 | \f |
18 | ||
19 | \f | |
20 | /* Defining Scheme functions implemented by C functions --- subrs. */ | |
21 | ||
a0599745 | 22 | #include "libguile/gh.h" |
ee2a8b9b | 23 | |
5c56ebe1 MV |
24 | #if SCM_ENABLE_DEPRECATED |
25 | ||
ee2a8b9b JB |
26 | /* allows you to define new scheme primitives written in C */ |
27 | SCM | |
bcee10dd | 28 | gh_new_procedure (const char *proc_name, SCM (*fn) (), |
ee2a8b9b JB |
29 | int n_required_args, int n_optional_args, int varp) |
30 | { | |
9a441ddb MV |
31 | return scm_c_define_gsubr (proc_name, n_required_args, n_optional_args, |
32 | varp, fn); | |
ee2a8b9b JB |
33 | } |
34 | ||
35 | SCM | |
bcee10dd | 36 | gh_new_procedure0_0 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
37 | { |
38 | return gh_new_procedure (proc_name, fn, 0, 0, 0); | |
39 | } | |
40 | ||
41 | SCM | |
bcee10dd | 42 | gh_new_procedure0_1 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
43 | { |
44 | return gh_new_procedure (proc_name, fn, 0, 1, 0); | |
45 | } | |
46 | ||
47 | SCM | |
bcee10dd | 48 | gh_new_procedure0_2 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
49 | { |
50 | return gh_new_procedure (proc_name, fn, 0, 2, 0); | |
51 | } | |
52 | ||
53 | SCM | |
bcee10dd | 54 | gh_new_procedure1_0 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
55 | { |
56 | return gh_new_procedure (proc_name, fn, 1, 0, 0); | |
57 | } | |
58 | ||
59 | SCM | |
bcee10dd | 60 | gh_new_procedure1_1 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
61 | { |
62 | return gh_new_procedure (proc_name, fn, 1, 1, 0); | |
63 | } | |
64 | ||
65 | SCM | |
bcee10dd | 66 | gh_new_procedure1_2 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
67 | { |
68 | return gh_new_procedure (proc_name, fn, 1, 2, 0); | |
69 | } | |
70 | ||
71 | SCM | |
bcee10dd | 72 | gh_new_procedure2_0 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
73 | { |
74 | return gh_new_procedure (proc_name, fn, 2, 0, 0); | |
75 | } | |
76 | ||
77 | SCM | |
bcee10dd | 78 | gh_new_procedure2_1 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
79 | { |
80 | return gh_new_procedure (proc_name, fn, 2, 1, 0); | |
81 | } | |
82 | ||
83 | SCM | |
bcee10dd | 84 | gh_new_procedure2_2 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
85 | { |
86 | return gh_new_procedure (proc_name, fn, 2, 2, 0); | |
87 | } | |
88 | ||
89 | SCM | |
bcee10dd | 90 | gh_new_procedure3_0 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
91 | { |
92 | return gh_new_procedure (proc_name, fn, 3, 0, 0); | |
93 | } | |
94 | ||
95 | SCM | |
bcee10dd | 96 | gh_new_procedure4_0 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
97 | { |
98 | return gh_new_procedure (proc_name, fn, 4, 0, 0); | |
99 | } | |
100 | ||
101 | SCM | |
bcee10dd | 102 | gh_new_procedure5_0 (const char *proc_name, SCM (*fn) ()) |
ee2a8b9b JB |
103 | { |
104 | return gh_new_procedure (proc_name, fn, 5, 0, 0); | |
105 | } | |
106 | ||
107 | /* some (possibly most) Scheme functions available from C */ | |
108 | SCM | |
bcee10dd | 109 | gh_define (const char *name, SCM val) |
ee2a8b9b | 110 | { |
86d31dfe MV |
111 | scm_c_define (name, val); |
112 | return SCM_UNSPECIFIED; | |
ee2a8b9b JB |
113 | } |
114 | ||
115 | \f | |
116 | /* Calling Scheme functions from C. */ | |
117 | ||
118 | SCM | |
119 | gh_apply (SCM proc, SCM args) | |
120 | { | |
121 | return scm_apply (proc, args, SCM_EOL); | |
122 | } | |
123 | ||
124 | SCM | |
125 | gh_call0 (SCM proc) | |
126 | { | |
127 | return scm_apply (proc, SCM_EOL, SCM_EOL); | |
128 | } | |
129 | ||
130 | SCM | |
131 | gh_call1 (SCM proc, SCM arg) | |
132 | { | |
133 | return scm_apply (proc, arg, scm_listofnull); | |
134 | } | |
135 | ||
136 | SCM | |
137 | gh_call2 (SCM proc, SCM arg1, SCM arg2) | |
138 | { | |
139 | return scm_apply (proc, arg1, scm_cons (arg2, scm_listofnull)); | |
140 | } | |
141 | ||
142 | SCM | |
143 | gh_call3 (SCM proc, SCM arg1, SCM arg2, SCM arg3) | |
144 | { | |
145 | return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull)); | |
146 | } | |
89e00824 | 147 | |
5c56ebe1 MV |
148 | #endif /* SCM_ENABLE_DEPRECATED */ |
149 | ||
89e00824 ML |
150 | /* |
151 | Local Variables: | |
152 | c-file-style: "gnu" | |
153 | End: | |
154 | */ |