Commit | Line | Data |
---|---|---|
8f5cfc81 | 1 | /* Copyright (C) 2001 Free Software Foundation, Inc. |
a98cef7e KN |
2 | * |
3 | * 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 | |
5 | * the Free Software Foundation; either version 2, or (at your option) | |
6 | * any later version. | |
7 | * | |
8 | * This program 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 | |
11 | * GNU General Public License for more details. | |
12 | * | |
13 | * 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 | |
15 | * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, | |
16 | * Boston, MA 02111-1307 USA | |
17 | * | |
18 | * As a special exception, the Free Software Foundation gives permission | |
19 | * for additional uses of the text contained in its release of GUILE. | |
20 | * | |
21 | * The exception is that, if you link the GUILE library with other files | |
22 | * to produce an executable, this does not by itself cause the | |
23 | * resulting executable to be covered by the GNU General Public License. | |
24 | * Your use of that executable is in no way restricted on account of | |
25 | * linking the GUILE library code into it. | |
26 | * | |
27 | * This exception does not however invalidate any other reasons why | |
28 | * the executable file might be covered by the GNU General Public License. | |
29 | * | |
30 | * This exception applies only to the code released by the | |
31 | * Free Software Foundation under the name GUILE. If you copy | |
32 | * code from other Free Software Foundation releases into a copy of | |
33 | * GUILE, as the General Public License permits, the exception does | |
34 | * not apply to the code that you add in this way. To avoid misleading | |
35 | * anyone as to the status of such modified files, you must delete | |
36 | * this exception notice from them. | |
37 | * | |
38 | * If you write modifications of your own for GUILE, it is your choice | |
39 | * whether to permit this exception to apply to your modifications. | |
40 | * If you do not wish that, delete this exception notice. */ | |
41 | ||
42 | /* This file is included in vm_engine.c */ | |
43 | ||
a80be762 KN |
44 | \f |
45 | /* | |
46 | * Predicates | |
47 | */ | |
48 | ||
17e90c5e | 49 | VM_DEFINE_FUNCTION (not, "not", 1) |
a98cef7e | 50 | { |
a80be762 KN |
51 | ARGS1 (x); |
52 | RETURN (SCM_BOOL (SCM_FALSEP (x))); | |
17e90c5e KN |
53 | } |
54 | ||
55 | VM_DEFINE_FUNCTION (not_not, "not-not", 1) | |
56 | { | |
a80be762 KN |
57 | ARGS1 (x); |
58 | RETURN (SCM_BOOL (!SCM_FALSEP (x))); | |
17e90c5e KN |
59 | } |
60 | ||
61 | VM_DEFINE_FUNCTION (eq, "eq?", 2) | |
62 | { | |
a80be762 KN |
63 | ARGS2 (x, y); |
64 | RETURN (SCM_BOOL (SCM_EQ_P (x, y))); | |
17e90c5e KN |
65 | } |
66 | ||
67 | VM_DEFINE_FUNCTION (not_eq, "not-eq?", 2) | |
68 | { | |
a80be762 KN |
69 | ARGS2 (x, y); |
70 | RETURN (SCM_BOOL (!SCM_EQ_P (x, y))); | |
17e90c5e KN |
71 | } |
72 | ||
73 | VM_DEFINE_FUNCTION (nullp, "null?", 1) | |
74 | { | |
a80be762 KN |
75 | ARGS1 (x); |
76 | RETURN (SCM_BOOL (SCM_NULLP (x))); | |
a98cef7e KN |
77 | } |
78 | ||
17e90c5e | 79 | VM_DEFINE_FUNCTION (not_nullp, "not-null?", 1) |
a98cef7e | 80 | { |
a80be762 KN |
81 | ARGS1 (x); |
82 | RETURN (SCM_BOOL (!SCM_NULLP (x))); | |
83 | } | |
84 | ||
85 | VM_DEFINE_FUNCTION (eqv, "eqv?", 2) | |
86 | { | |
87 | ARGS2 (x, y); | |
88 | if (SCM_EQ_P (x, y)) | |
89 | RETURN (SCM_BOOL_T); | |
90 | if (SCM_IMP (x) || SCM_IMP (y)) | |
91 | RETURN (SCM_BOOL_F); | |
92 | SYNC_BEFORE_GC (); | |
93 | RETURN (scm_eqv_p (x, y)); | |
94 | } | |
95 | ||
96 | VM_DEFINE_FUNCTION (equal, "equal?", 2) | |
97 | { | |
98 | ARGS2 (x, y); | |
99 | if (SCM_EQ_P (x, y)) | |
100 | RETURN (SCM_BOOL_T); | |
101 | if (SCM_IMP (x) || SCM_IMP (y)) | |
102 | RETURN (SCM_BOOL_F); | |
103 | SYNC_BEFORE_GC (); | |
104 | RETURN (scm_equal_p (x, y)); | |
a98cef7e KN |
105 | } |
106 | ||
17e90c5e | 107 | VM_DEFINE_FUNCTION (pairp, "pair?", 1) |
a98cef7e | 108 | { |
a80be762 KN |
109 | ARGS1 (x); |
110 | RETURN (SCM_BOOL (SCM_CONSP (x))); | |
a98cef7e KN |
111 | } |
112 | ||
17e90c5e | 113 | VM_DEFINE_FUNCTION (listp, "list?", 1) |
a98cef7e | 114 | { |
a80be762 KN |
115 | ARGS1 (x); |
116 | RETURN (SCM_BOOL (scm_ilength (x) >= 0)); | |
a98cef7e KN |
117 | } |
118 | ||
a80be762 KN |
119 | \f |
120 | /* | |
121 | * Basic data | |
122 | */ | |
123 | ||
17e90c5e | 124 | VM_DEFINE_FUNCTION (cons, "cons", 2) |
a98cef7e | 125 | { |
a80be762 KN |
126 | ARGS2 (x, y); |
127 | CONS (x, x, y); | |
128 | RETURN (x); | |
a98cef7e KN |
129 | } |
130 | ||
17e90c5e | 131 | VM_DEFINE_FUNCTION (car, "car", 1) |
a98cef7e | 132 | { |
a80be762 KN |
133 | ARGS1 (x); |
134 | SCM_VALIDATE_CONS (1, x); | |
135 | RETURN (SCM_CAR (x)); | |
a98cef7e KN |
136 | } |
137 | ||
17e90c5e | 138 | VM_DEFINE_FUNCTION (cdr, "cdr", 1) |
a98cef7e | 139 | { |
a80be762 KN |
140 | ARGS1 (x); |
141 | SCM_VALIDATE_CONS (1, x); | |
142 | RETURN (SCM_CDR (x)); | |
a98cef7e KN |
143 | } |
144 | ||
17e90c5e | 145 | VM_DEFINE_FUNCTION (set_car, "set-car!", 2) |
a98cef7e | 146 | { |
a80be762 KN |
147 | ARGS2 (x, y); |
148 | SCM_VALIDATE_CONS (1, x); | |
149 | SCM_SETCAR (x, y); | |
17e90c5e | 150 | RETURN (SCM_UNSPECIFIED); |
a98cef7e KN |
151 | } |
152 | ||
17e90c5e | 153 | VM_DEFINE_FUNCTION (set_cdr, "set-cdr!", 2) |
a98cef7e | 154 | { |
a80be762 KN |
155 | ARGS2 (x, y); |
156 | SCM_VALIDATE_CONS (1, x); | |
157 | SCM_SETCDR (x, y); | |
17e90c5e | 158 | RETURN (SCM_UNSPECIFIED); |
a98cef7e KN |
159 | } |
160 | ||
a80be762 KN |
161 | \f |
162 | /* | |
163 | * Numeric relational tests | |
164 | */ | |
165 | ||
166 | #undef REL | |
d8eeb67c LC |
167 | #define REL(crel,srel) \ |
168 | { \ | |
169 | ARGS2 (x, y); \ | |
2d80426a LC |
170 | if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ |
171 | RETURN (SCM_BOOL (SCM_I_INUM (x) crel SCM_I_INUM (y))); \ | |
d8eeb67c | 172 | RETURN (srel (x, y)); \ |
a80be762 KN |
173 | } |
174 | ||
175 | VM_DEFINE_FUNCTION (ee, "ee?", 2) | |
176 | { | |
177 | REL (==, scm_num_eq_p); | |
178 | } | |
179 | ||
180 | VM_DEFINE_FUNCTION (lt, "lt?", 2) | |
181 | { | |
182 | REL (<, scm_less_p); | |
183 | } | |
184 | ||
185 | VM_DEFINE_FUNCTION (le, "le?", 2) | |
186 | { | |
187 | REL (<=, scm_leq_p); | |
188 | } | |
189 | ||
190 | VM_DEFINE_FUNCTION (gt, "gt?", 2) | |
191 | { | |
192 | REL (>, scm_gr_p); | |
193 | } | |
194 | ||
195 | VM_DEFINE_FUNCTION (ge, "ge?", 2) | |
196 | { | |
197 | REL (>=, scm_geq_p); | |
198 | } | |
199 | ||
200 | \f | |
201 | /* | |
202 | * Numeric functions | |
203 | */ | |
204 | ||
205 | #undef FUNC1 | |
206 | #define FUNC1(CEXP,SEXP) \ | |
207 | { \ | |
208 | ARGS1 (x); \ | |
2d80426a | 209 | if (SCM_I_INUMP (x)) \ |
a80be762 KN |
210 | { \ |
211 | int n = CEXP; \ | |
212 | if (SCM_FIXABLE (n)) \ | |
2d80426a | 213 | RETURN (SCM_I_MAKINUM (n)); \ |
a80be762 KN |
214 | } \ |
215 | RETURN (SEXP); \ | |
216 | } | |
217 | ||
218 | #undef FUNC2 | |
219 | #define FUNC2(CFUNC,SFUNC) \ | |
220 | { \ | |
d8eeb67c | 221 | ARGS2 (x, y); \ |
2d80426a | 222 | if (SCM_I_INUMP (x) && SCM_I_INUMP (y)) \ |
a80be762 | 223 | { \ |
2d80426a | 224 | int n = SCM_I_INUM (x) CFUNC SCM_I_INUM (y); \ |
a80be762 | 225 | if (SCM_FIXABLE (n)) \ |
2d80426a | 226 | RETURN (SCM_I_MAKINUM (n)); \ |
a80be762 KN |
227 | } \ |
228 | RETURN (SFUNC (x, y)); \ | |
229 | } | |
230 | ||
231 | VM_DEFINE_FUNCTION (add, "add", 2) | |
232 | { | |
233 | FUNC2 (+, scm_sum); | |
234 | } | |
235 | ||
236 | VM_DEFINE_FUNCTION (sub, "sub", 2) | |
237 | { | |
238 | FUNC2 (-, scm_difference); | |
239 | } | |
240 | ||
241 | VM_DEFINE_FUNCTION (mul, "mul", 2) | |
242 | { | |
243 | ARGS2 (x, y); | |
244 | RETURN (scm_product (x, y)); | |
245 | } | |
246 | ||
247 | VM_DEFINE_FUNCTION (div, "div", 2) | |
248 | { | |
249 | ARGS2 (x, y); | |
250 | RETURN (scm_divide (x, y)); | |
251 | } | |
252 | ||
253 | VM_DEFINE_FUNCTION (quo, "quo", 2) | |
254 | { | |
255 | ARGS2 (x, y); | |
256 | RETURN (scm_quotient (x, y)); | |
257 | } | |
258 | ||
259 | VM_DEFINE_FUNCTION (rem, "rem", 2) | |
260 | { | |
261 | ARGS2 (x, y); | |
262 | RETURN (scm_remainder (x, y)); | |
263 | } | |
264 | ||
265 | VM_DEFINE_FUNCTION (mod, "mod", 2) | |
266 | { | |
267 | ARGS2 (x, y); | |
268 | RETURN (scm_modulo (x, y)); | |
269 | } | |
270 | ||
17e90c5e KN |
271 | /* |
272 | Local Variables: | |
273 | c-file-style: "gnu" | |
274 | End: | |
275 | */ |