1 /*
2 * ProcedureMacro.h -
3 *
4 * Copyright (c) 2008 Higepon(Taro Minowa) <higepon@users.sourceforge.jp>
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
18 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
19 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
20 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
21 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
22 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
23 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
24 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
25 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 *
29 * $Id: ProcedureMacro.h 261 2008-07-25 06:16:44Z higepon $
30 */
31
32 #ifndef SCHEME_PROCEDURE_MACRO_
33 #define SCHEME_PROCEDURE_MACRO_
34
35 #include "scheme.h"
36 #include "ErrorProcedures.h"
37 #include "StringProcedures.h"
38 #include "VM.h"
39
40
41 #define checkPortIsOpen(port, obj) \
42 if (port->isClosed()) { \
43 return callIOReadErrorAfter(theVM, obj, procedureName, "port is closed"); \
44 }
45
46
47 // N.B For BinaryInputOutputPort Class, we use multiple inheritance.
48 // It is dangerous to reinterpret_cast<BinaryInput*>(theInstance).
49 // So we use special versio of argumentAsBinaryOutputPort and argumentAsBinaryInputPort.
50
51 #define argumentAsPort(index, variableName) \
52 const Object obj ## variableName = argv[index]; \
53 Port* variableName; \
54 if (obj ## variableName.isBinaryOutputPort()) { \
55 variableName = obj ## variableName.toBinaryOutputPort(); \
56 } else if (obj ## variableName.isBinaryInputPort()) { \
57 variableName = obj ## variableName.toBinaryInputPort(); \
58 } else if (obj ## variableName.isTextualInputPort()) { \
59 variableName = obj ## variableName.toTextualInputPort(); \
60 } else if (obj ## variableName.isTextualOutputPort()) { \
61 variableName = obj ## variableName.toTextualOutputPort(); \
62 } else if (obj ## variableName.isTextualInputOutputPort()) { \
63 variableName = obj ## variableName.toTextualInputOutputPort(); \
64 } else if (obj ## variableName.isBinaryInputOutputPort()) { \
65 variableName = obj ## variableName.toBinaryInputOutputPort(); \
66 } else { \
67 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "port", obj ## variableName); \
68 return Object::Undef; \
69 }
70
71
72 #define argumentAsBinaryOutputPort(index, variableName) \
73 const Object obj ## variableName = argv[index]; \
74 BinaryOutputPort* variableName; \
75 if (obj ## variableName.isBinaryOutputPort()) { \
76 variableName = obj ## variableName.toBinaryOutputPort(); \
77 } else if (obj ## variableName.isBinaryInputOutputPort()) { \
78 variableName = obj ## variableName.toBinaryInputOutputPort(); \
79 } else { \
80 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "binary-output-port", obj ## variableName); \
81 return Object::Undef; \
82 }
83
84 #define argumentAsBinaryInputPort(index, variableName) \
85 const Object obj ## variableName = argv[index]; \
86 BinaryInputPort* variableName; \
87 if (obj ## variableName.isBinaryInputPort()) { \
88 variableName = obj ## variableName.toBinaryInputPort(); \
89 } else if (obj ## variableName.isBinaryInputOutputPort()) { \
90 variableName = obj ## variableName.toBinaryInputOutputPort(); \
91 } else { \
92 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "binary-input-port", obj ## variableName); \
93 return Object::Undef; \
94 }
95
96 #define argumentAsU32(index, variableName) \
97 const Object obj ## variableName = argv[index]; \
98 uint32_t variableName; \
99 if (obj ## variableName.isFixnum()) { \
100 variableName = obj ## variableName.toFixnum(); \
101 } else if (obj ## variableName.isBignum()) { \
102 variableName = obj ## variableName.toBignum()->toU32(); \
103 } else { \
104 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "uint32", obj ## variableName); \
105 return Object::Undef; \
106 }
107
108 #define argumentAsTextualOutputPort(index, variableName) \
109 const Object obj ## variableName = argv[index]; \
110 TextualOutputPort* variableName; \
111 if (obj ## variableName.isTextualOutputPort()) { \
112 variableName = obj ## variableName.toTextualOutputPort(); \
113 } else if (obj ## variableName.isTextualInputOutputPort()) { \
114 variableName = obj ## variableName.toTextualInputOutputPort(); \
115 } else { \
116 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "textual-output-port", obj ## variableName); \
117 return Object::Undef; \
118 }
119
120 #define argumentAsTextualInputPort(index, variableName) \
121 const Object obj ## variableName = argv[index]; \
122 TextualInputPort* variableName; \
123 if (obj ## variableName.isTextualInputPort()) { \
124 variableName = obj ## variableName.toTextualInputPort(); \
125 } else if (obj ## variableName.isTextualInputOutputPort()) { \
126 variableName = obj ## variableName.toTextualInputOutputPort(); \
127 } else { \
128 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, "textual-input-port", obj ## variableName); \
129 return Object::Undef; \
130 }
131
132
133
134 #define checkType(index, variableName, pred, required) \
135 const Object variableName = argv[index]; \
136 if (!variableName.pred()) { \
137 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, #required, variableName); \
138 return Object::Undef; \
139 } \
140
141 #define castArgument(index, variableName, pred, required, type, castFunction) \
142 const Object obj ## variableName = argv[index]; \
143 if (!obj ## variableName.pred()) { \
144 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, #required, obj ## variableName); \
145 return Object::Undef; \
146 } \
147 type variableName = obj ## variableName.castFunction();
148
149
150 #define checkTypeOrFalse(index, variableName, pred, required) \
151 const Object variableName = argv[index]; \
152 if (!variableName.pred() && !variableName.isFalse()) { \
153 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, #required " or #f", variableName); \
154 return Object::Undef; \
155 } \
156
157 #define checkTypeOr(index, variableName, pred1, pred2, required1, required2) \
158 const Object variableName = argv[index]; \
159 if (!variableName.pred1() && !variableName.pred2()) { \
160 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, #required1 " or " #required2, variableName); \
161 return Object::Undef; \
162 } \
163
164 #define argumentCheckList(index, variableName) checkType(index, variableName, isList, list)
165 #define argumentAsSymbol(index, variableName) castArgument(index, variableName, isSymbol, symbol, Symbol*, toSymbol)
166 #define argumentAsVM(index, variableName) castArgument(index, variableName, isVM, vm, VM*, toVM)
167 #define argumentAsMutex(index, variableName) castArgument(index, variableName, isMutex, mutex, Mutex*, toMutex)
168 #define argumentAsConditionVariable(index, variableName) castArgument(index, variableName, isConditionVariable, condition-variable, ConditionVariable*, toConditionVariable)
169 #define argumentAsVector(index, variableName) castArgument(index, variableName, isVector, vector, Vector*, toVector)
170 #define argumentAsCodeBuilder(index, variableName) castArgument(index, variableName, isCodeBuilder, code-builder, CodeBuilder*, toCodeBuilder)
171
172 #define argumentAsAnnotatedPair(index, variableName) castArgument(index, variableName, isAnnotatedPair, AnnotatedPair, AnnotatedPair*, toAnnotatedPair)
173 #define argumentAsPointer(index, variableName) castArgument(index, variableName, isPointer, pointer, Pointer*, toPointer)
174 #define argumentAsSocket(index, variableName) castArgument(index, variableName, isSocket, socket, Socket*, toSocket)
175 #define argumentAsSimpleStruct(index, variableName) castArgument(index, variableName, isSimpleStruct, simple-struct, SimpleStruct*, toSimpleStruct)
176 #define argumentAsFlonum(index, variableName) castArgument(index, variableName, isFlonum, flonum, Flonum*, toFlonum)
177 #define argumentAsFixnum(index, variableName) castArgument(index, variableName, isFixnum, fixnum, int, toFixnum)
178
nth(int index)179 inline const char* nth(int index) {
180 switch(index) {
181 case(0):
182 return "1st";
183 case(1):
184 return "2nd";
185 case(2):
186 return "3rd";
187 default:
188 static char buf[16];
189 sprintf(buf, "%dth", index + 1);
190 return buf;
191 }
192 }
193
194 #define argumentAsPositiveFixnum(index, variableName) \
195 argumentAsFixnum(index, variableName); \
196 if (variableName <= 0) { \
197 static char buf[64]; \
198 sprintf(buf, "%s argument: positive integer", nth(index)); \
199 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, ucs4string::from_c_str(buf), argv[index]); \
200 return Object::Undef; \
201 }
202
203 #define argumentAsNonNegativeFixnum(index, variableName) \
204 argumentAsFixnum(index, variableName); \
205 if (variableName < 0) { \
206 static char buf[64]; \
207 sprintf(buf, "%s argument: non-negative integer", nth(index)); \
208 callWrongTypeOfArgumentViolationAfter(theVM, procedureName, ucs4string::from_c_str(buf), argv[index]); \
209 return Object::Undef; \
210 }
211
212
213 #define argumentAsOctet(index, variableName) castArgument(index, variableName, isOctet, octet, uint8_t, toFixnum)
214 #define argumentAsCompnum(index, variableName) castArgument(index, variableName, isCompnum, Complex number, Compnum*, toCompnum)
215 #define argumentAsHashTable(index, variableName) castArgument(index, variableName, isHashTable, hashtable, HashTable*, toHashTable)
216 #define argumentCheckChar(index, variableName) checkType(index, variableName, isChar, char)
217 #define argumentCheckFixnum(index, variableName) checkType(index, variableName, isFixnum, fixnum)
218 #define argumentCheckFlonum(index, variableName) checkType(index, variableName, isFlonum, flonum)
219 #define argumentCheckExactInteger(index, variableName) checkType(index, variableName, isExactInteger, exact integer)
220 #define argumentCheckIntegerValued(index, variableName) checkType(index, variableName, isIntegerValued, integer)
221 #define argumentCheckNumber(index, variableName) checkType(index, variableName, isNumber, number)
222 #define argumentCheckRational(index, variableName) checkType(index, variableName, isRational, rational number)
223 #define argumentCheckReal(index, variableName) checkType(index, variableName, isReal, real)
224 #define argumentAsClosure(index, variableName) castArgument(index, variableName, isClosure, closure, Closure*, toClosure)
225
226 #define argumentCheckProcedure(index, variableName) checkType(index, variableName, isProcedure, procedure)
227
228 #define argumentCheckVector(index, variableName) checkType(index, variableName, isVector, vector)
229
230 #define argumentCheckString(index, variableName) checkType(index, variableName, isString, string)
231 #define argumentCheckSymbol(index, variableName) checkType(index, variableName, isSymbol, symbol)
232 #define argumentCheckSimpleStruct(index, variableName) checkType(index, variableName, isSimpleStruct, simplestruct)
233 #define argumentCheckSymbolOrFalse(index, variableName) checkTypeOrFalse(index, variableName, isSymbol, symbol)
234 #define argumentCheckStringOrFalse(index, variableName) checkTypeOrFalse(index, variableName, isString, string)
235
236 #define argumentCheckBoolean(index, variableName) checkType(index, variableName, isBoolean, boolean)
237 #define argumentCheckClosure(index, variableName) checkType(index, variableName, isClosure, closure)
238 #define argumentCheckClosureOrFalse(index, variableName) checkTypeOrFalse(index, variableName, isClosure, closure)
239
240
241 //#define argumentAsPort(index, variableName) castArgument(index, variableName, isPort, port, Port*, toPort)
242 #define argumentCheckPair(index, variableName) checkType(index, variableName, isPair, pair)
243
244 //#define argumentAsTextualOutputPort(index, variableName) castArgument(index, variableName, isTextualOutputPort, textual-output-port, TextualOutputPort*, toTextualOutputPort)
245
246 #define argumentAsRegexp(index, variableName) castArgument(index, variableName, isRegexp, regexp, Regexp*, toRegexp)
247 #define argumentAsRegMatch(index, variableName) castArgument(index, variableName, isRegMatch, regexp, RegMatch*, toRegMatch)
248 #define argumentAsString(index, variableName) castArgument(index, variableName, isString, string, String*, toString)
249
250
251 #define argumentAsChar(index, variableName) castArgument(index, variableName, isChar, character, ucs4char, toChar)
252
253 #define argumentCheckProcedure(index, variableName) checkType(index, variableName, isProcedure, procedure)
254 #define argumentCheckProcedureOrFalse(index, variableName) checkTypeOrFalse(index, variableName, isProcedure, procedure)
255
256 #define argumentAsByteVector(index, variableName) castArgument(index, variableName, isByteVector, bytevector, ByteVector*, toByteVector)
257 #define argumentAsTranscoder(index, variableName) castArgument(index, variableName, isTranscoder, transcoder, Transcoder*, toTranscoder)
258 #define argumentAsCodec(index, variableName) castArgument(index, variableName, isCodec, codec, Codec*, toCodec)
259 #define argumentCheckTextualInputPort(index, variableName) checkType(index, variableName, isTextualInputPort, textual-input-port)
260 #define argumentCheckTextualOutputPort(index, variableName) checkType(index, variableName, isTextualOutputPort, textual-output-port)
261 #define argumentCheckOutputPort(index, variableName) checkType(index, variableName, isOutputPort, output-port)
262 #define argumentCheckPort(index, variableName) checkType(index, variableName, isPort, port)
263 #define argumentCheckTranscoderOrFalse(index, variableName) checkTypeOrFalse(index, variableName, isTranscoder, transcoder)
264
265
266 #define DeclareProcedureName(name) const ucs4char* procedureName = UC(name); theVM->setNumValues1();
267
268 #define checkArgumentLength(required) \
269 if (argc != required) { \
270 callWrongNumberOfArgumentsViolationAfter(theVM, procedureName, required, argc); \
271 return Object::Undef;\
272 } \
273
274 #define checkArgumentLengthBetween(start, end) \
275 if (argc < start || argc > end) { \
276 callWrongNumberOfArgumentsBetweenViolationAfter(theVM, procedureName, start, end, argc); \
277 return Object::Undef;\
278 } \
279
280 //#define argumentAsTextualInputPort(index, variableName) castArgument(index, variableName, isTextualInputPort, textual-input-port, TextualInputPort*, toTextualInputPort)
281
282 #define checkArgumentLengthAtLeast(required) \
283 if (argc < required) { \
284 callWrongNumberOfArgumentsAtLeastViolationAfter(theVM, procedureName, required, argc); \
285 return Object::Undef;\
286 } \
287
288 #endif // SCHEME_PROCEDURE_MACRO_
289