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