| 1 | /* classes: h_files */ |
| 2 | |
| 3 | #ifndef SCM_VALIDATE_H |
| 4 | #define SCM_VALIDATE_H |
| 5 | |
| 6 | /* Copyright (C) 1999,2000,2001, 2002, 2004, 2006, 2007, 2009, 2011 Free Software Foundation, Inc. |
| 7 | * |
| 8 | * This library is free software; you can redistribute it and/or |
| 9 | * modify it under the terms of the GNU Lesser General Public License |
| 10 | * as published by the Free Software Foundation; either version 3 of |
| 11 | * the License, or (at your option) any later version. |
| 12 | * |
| 13 | * This library is distributed in the hope that it will be useful, but |
| 14 | * WITHOUT ANY WARRANTY; without even the implied warranty of |
| 15 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
| 16 | * Lesser General Public License for more details. |
| 17 | * |
| 18 | * You should have received a copy of the GNU Lesser General Public |
| 19 | * License along with this library; if not, write to the Free Software |
| 20 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
| 21 | * 02110-1301 USA |
| 22 | */ |
| 23 | |
| 24 | /* Written by Greg J. Badros <gjb@cs.washington.edu>, Dec-1999 */ |
| 25 | |
| 26 | \f |
| 27 | |
| 28 | #define SCM_SYSERROR do { scm_syserror (FUNC_NAME); } while (0) |
| 29 | |
| 30 | #define SCM_MEMORY_ERROR do { scm_memory_error (FUNC_NAME); } while (0) |
| 31 | |
| 32 | #define SCM_SYSERROR_MSG(str, args, val) \ |
| 33 | do { scm_syserror_msg (FUNC_NAME, (str), (args), (val)); } while (0) |
| 34 | |
| 35 | #define SCM_MISC_ERROR(str, args) \ |
| 36 | do { scm_misc_error (FUNC_NAME, str, args); } while (0) |
| 37 | |
| 38 | #define SCM_WRONG_NUM_ARGS() \ |
| 39 | do { scm_error_num_args_subr (FUNC_NAME); } while (0) |
| 40 | |
| 41 | #define SCM_WRONG_TYPE_ARG(pos, obj) \ |
| 42 | do { scm_wrong_type_arg (FUNC_NAME, pos, obj); } while (0) |
| 43 | |
| 44 | #define SCM_NUM2SIZE(pos, arg) (scm_to_size_t (arg)) |
| 45 | |
| 46 | #define SCM_NUM2SIZE_DEF(pos, arg, def) \ |
| 47 | (SCM_UNBNDP (arg) ? def : scm_to_size_t (arg)) |
| 48 | |
| 49 | #define SCM_NUM2PTRDIFF(pos, arg) (scm_to_ssize_t (arg)) |
| 50 | |
| 51 | #define SCM_NUM2PTRDIFF_DEF(pos, arg, def) \ |
| 52 | (SCM_UNBNDP (arg) ? def : scm_to_ssize_t (arg)) |
| 53 | |
| 54 | #define SCM_NUM2SHORT(pos, arg) (scm_to_short (arg)) |
| 55 | |
| 56 | #define SCM_NUM2SHORT_DEF(pos, arg, def) \ |
| 57 | (SCM_UNBNDP (arg) ? def : scm_to_short (arg)) |
| 58 | |
| 59 | #define SCM_NUM2USHORT(pos, arg) (scm_to_ushort (arg)) |
| 60 | |
| 61 | #define SCM_NUM2USHORT_DEF(pos, arg, def) \ |
| 62 | (SCM_UNBNDP (arg) ? def : scm_to_ushort (arg)) |
| 63 | |
| 64 | #define SCM_NUM2INT(pos, arg) (scm_to_int (arg)) |
| 65 | |
| 66 | #define SCM_NUM2INT_DEF(pos, arg, def) \ |
| 67 | (SCM_UNBNDP (arg) ? def : scm_to_int (arg)) |
| 68 | |
| 69 | #define SCM_NUM2UINT(pos, arg) (scm_to_uint (arg)) |
| 70 | |
| 71 | #define SCM_NUM2UINT_DEF(pos, arg, def) \ |
| 72 | (SCM_UNBNDP (arg) ? def : scm_to_uint (arg)) |
| 73 | |
| 74 | #define SCM_NUM2ULONG(pos, arg) (scm_to_ulong (arg)) |
| 75 | |
| 76 | #define SCM_NUM2ULONG_DEF(pos, arg, def) \ |
| 77 | (SCM_UNBNDP (arg) ? def : scm_to_ulong (arg)) |
| 78 | |
| 79 | #define SCM_NUM2LONG(pos, arg) (scm_to_long (arg)) |
| 80 | |
| 81 | #define SCM_NUM2LONG_DEF(pos, arg, def) \ |
| 82 | (SCM_UNBNDP (arg) ? def : scm_to_long (arg)) |
| 83 | |
| 84 | #define SCM_NUM2LONG_LONG(pos, arg) (scm_to_long_long (arg)) |
| 85 | |
| 86 | #define SCM_NUM2LONG_LONG_DEF(pos, arg, def) \ |
| 87 | (SCM_UNBNDP (arg) ? def : scm_to_long_long (arg)) |
| 88 | |
| 89 | #define SCM_NUM2ULONG_LONG(pos, arg) (scm_to_ulong_long (arg)) |
| 90 | |
| 91 | #define SCM_NUM2ULONG_LONG_DEF(pos, arg, def) \ |
| 92 | (SCM_UNBNDP (arg) ? def : scm_to_ulong_long (arg)) |
| 93 | |
| 94 | #define SCM_NUM2FLOAT(pos, arg) \ |
| 95 | (scm_num2float (arg, pos, FUNC_NAME)) |
| 96 | |
| 97 | #define SCM_NUM2DOUBLE(pos, arg) \ |
| 98 | (scm_num2double (arg, pos, FUNC_NAME)) |
| 99 | |
| 100 | #define SCM_OUT_OF_RANGE(pos, arg) \ |
| 101 | do { scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } while (0) |
| 102 | |
| 103 | #define SCM_ASSERT_RANGE(pos, arg, f) \ |
| 104 | do { if (SCM_UNLIKELY (!(f))) \ |
| 105 | scm_out_of_range_pos (FUNC_NAME, arg, scm_from_int (pos)); } \ |
| 106 | while (0) |
| 107 | |
| 108 | #define SCM_MUST_MALLOC_TYPE(type) \ |
| 109 | ((type *) scm_must_malloc (sizeof (type), FUNC_NAME)) |
| 110 | |
| 111 | #define SCM_MUST_MALLOC_TYPE_NUM(type, num) \ |
| 112 | ((type *) scm_must_malloc (sizeof (type) * (num), FUNC_NAME)) |
| 113 | |
| 114 | #define SCM_MUST_MALLOC(size) (scm_must_malloc ((size), FUNC_NAME)) |
| 115 | |
| 116 | #define SCM_MAKE_VALIDATE(pos, var, pred) \ |
| 117 | do { \ |
| 118 | SCM_ASSERT_TYPE (SCM_ ## pred (var), var, pos, FUNC_NAME, #pred); \ |
| 119 | } while (0) |
| 120 | |
| 121 | #define SCM_I_MAKE_VALIDATE_MSG2(pos, var, pred, msg) \ |
| 122 | do { \ |
| 123 | SCM_ASSERT_TYPE (pred (var), var, pos, FUNC_NAME, msg); \ |
| 124 | } while (0) |
| 125 | |
| 126 | #define SCM_MAKE_VALIDATE_MSG(pos, var, pred, msg) \ |
| 127 | SCM_I_MAKE_VALIDATE_MSG2 (pos, var, SCM_ ## pred, msg) |
| 128 | |
| 129 | |
| 130 | \f |
| 131 | |
| 132 | #define SCM_VALIDATE_REST_ARGUMENT(x) \ |
| 133 | do { \ |
| 134 | if (SCM_DEBUG_REST_ARGUMENT) { \ |
| 135 | if (scm_ilength (x) < 0) { \ |
| 136 | SCM_MISC_ERROR ("Rest arguments do not form a proper list.", SCM_EOL); \ |
| 137 | } \ |
| 138 | } \ |
| 139 | } while (0) |
| 140 | |
| 141 | #define SCM_VALIDATE_NIM(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, NIMP, "non-immediate") |
| 142 | |
| 143 | #define SCM_VALIDATE_BOOL(pos, flag) \ |
| 144 | do { \ |
| 145 | SCM_ASSERT_TYPE (scm_is_bool (flag), flag, pos, FUNC_NAME, "boolean"); \ |
| 146 | } while (0) |
| 147 | |
| 148 | #define SCM_VALIDATE_BOOL_COPY(pos, flag, cvar) \ |
| 149 | do { \ |
| 150 | SCM_ASSERT (scm_is_bool (flag), flag, pos, FUNC_NAME); \ |
| 151 | cvar = scm_to_bool (flag); \ |
| 152 | } while (0) |
| 153 | |
| 154 | #define SCM_VALIDATE_BYTEVECTOR(_pos, _obj) \ |
| 155 | SCM_ASSERT_TYPE (SCM_BYTEVECTOR_P (_obj), (_obj), (_pos), \ |
| 156 | FUNC_NAME, "bytevector") |
| 157 | |
| 158 | #define SCM_VALIDATE_CHAR(pos, scm) SCM_MAKE_VALIDATE_MSG (pos, scm, CHARP, "character") |
| 159 | |
| 160 | #define SCM_VALIDATE_CHAR_COPY(pos, scm, cvar) \ |
| 161 | do { \ |
| 162 | SCM_ASSERT (SCM_CHARP (scm), scm, pos, FUNC_NAME); \ |
| 163 | cvar = SCM_CHAR (scm); \ |
| 164 | } while (0) |
| 165 | |
| 166 | #define SCM_VALIDATE_STRING(pos, str) \ |
| 167 | do { \ |
| 168 | SCM_ASSERT_TYPE (scm_is_string (str), str, pos, FUNC_NAME, "string"); \ |
| 169 | } while (0) |
| 170 | |
| 171 | #define SCM_VALIDATE_REAL(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, REALP, "real") |
| 172 | |
| 173 | #define SCM_VALIDATE_NUMBER(pos, z) SCM_MAKE_VALIDATE_MSG (pos, z, NUMBERP, "number") |
| 174 | |
| 175 | #define SCM_VALIDATE_USHORT_COPY(pos, k, cvar) \ |
| 176 | do { \ |
| 177 | cvar = SCM_NUM2USHORT (pos, k); \ |
| 178 | } while (0) |
| 179 | |
| 180 | #define SCM_VALIDATE_SHORT_COPY(pos, k, cvar) \ |
| 181 | do { \ |
| 182 | cvar = SCM_NUM2SHORT (pos, k); \ |
| 183 | } while (0) |
| 184 | |
| 185 | #define SCM_VALIDATE_UINT_COPY(pos, k, cvar) \ |
| 186 | do { \ |
| 187 | cvar = SCM_NUM2UINT (pos, k); \ |
| 188 | } while (0) |
| 189 | |
| 190 | #define SCM_VALIDATE_INT_COPY(pos, k, cvar) \ |
| 191 | do { \ |
| 192 | cvar = SCM_NUM2INT (pos, k); \ |
| 193 | } while (0) |
| 194 | |
| 195 | #define SCM_VALIDATE_ULONG_COPY(pos, k, cvar) \ |
| 196 | do { \ |
| 197 | cvar = SCM_NUM2ULONG (pos, k); \ |
| 198 | } while (0) |
| 199 | |
| 200 | #define SCM_VALIDATE_LONG_COPY(pos, k, cvar) \ |
| 201 | do { \ |
| 202 | cvar = SCM_NUM2LONG (pos, k); \ |
| 203 | } while (0) |
| 204 | |
| 205 | #define SCM_VALIDATE_FLOAT_COPY(pos, k, cvar) \ |
| 206 | do { \ |
| 207 | cvar = SCM_NUM2FLOAT (pos, k); \ |
| 208 | } while (0) |
| 209 | |
| 210 | #define SCM_VALIDATE_DOUBLE_COPY(pos, k, cvar) \ |
| 211 | do { \ |
| 212 | cvar = SCM_NUM2DOUBLE (pos, k); \ |
| 213 | } while (0) |
| 214 | |
| 215 | #define SCM_VALIDATE_DOUBLE_DEF_COPY(pos, k, default, cvar) \ |
| 216 | do { \ |
| 217 | if (SCM_UNBNDP (k)) \ |
| 218 | { \ |
| 219 | k = scm_make_real (default); \ |
| 220 | cvar = default; \ |
| 221 | } \ |
| 222 | else \ |
| 223 | { \ |
| 224 | cvar = SCM_NUM2DOUBLE (pos, k); \ |
| 225 | } \ |
| 226 | } while (0) |
| 227 | |
| 228 | #define SCM_VALIDATE_NULL(pos, scm) \ |
| 229 | SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_null, "empty list") |
| 230 | |
| 231 | #define SCM_VALIDATE_NULL_OR_NIL(pos, scm) \ |
| 232 | SCM_MAKE_VALIDATE_MSG (pos, scm, NULL_OR_NIL_P, "empty list") |
| 233 | |
| 234 | #define SCM_VALIDATE_CONS(pos, scm) \ |
| 235 | SCM_I_MAKE_VALIDATE_MSG2 (pos, scm, scm_is_pair, "pair") |
| 236 | |
| 237 | #define SCM_VALIDATE_LIST(pos, lst) \ |
| 238 | do { \ |
| 239 | SCM_ASSERT (scm_ilength (lst) >= 0, lst, pos, FUNC_NAME); \ |
| 240 | } while (0) |
| 241 | |
| 242 | #define SCM_VALIDATE_NONEMPTYLIST(pos, lst) \ |
| 243 | do { \ |
| 244 | SCM_ASSERT (scm_ilength (lst) > 0, lst, pos, FUNC_NAME); \ |
| 245 | } while (0) |
| 246 | |
| 247 | #define SCM_VALIDATE_LIST_COPYLEN(pos, lst, cvar) \ |
| 248 | do { \ |
| 249 | cvar = scm_ilength (lst); \ |
| 250 | SCM_ASSERT (cvar >= 0, lst, pos, FUNC_NAME); \ |
| 251 | } while (0) |
| 252 | |
| 253 | #define SCM_VALIDATE_NONEMPTYLIST_COPYLEN(pos, lst, cvar) \ |
| 254 | do { \ |
| 255 | cvar = scm_ilength (lst); \ |
| 256 | SCM_ASSERT (cvar >= 1, lst, pos, FUNC_NAME); \ |
| 257 | } while (0) |
| 258 | |
| 259 | #define SCM_VALIDATE_ALISTCELL(pos, alist) \ |
| 260 | do { \ |
| 261 | SCM_ASSERT (scm_is_pair (alist) && scm_is_pair (SCM_CAR (alist)), \ |
| 262 | alist, pos, FUNC_NAME); \ |
| 263 | } while (0) |
| 264 | |
| 265 | #define SCM_VALIDATE_ALISTCELL_COPYSCM(pos, alist, cvar) \ |
| 266 | do { \ |
| 267 | SCM_ASSERT (scm_is_pair (alist), alist, pos, FUNC_NAME); \ |
| 268 | cvar = SCM_CAR (alist); \ |
| 269 | SCM_ASSERT (scm_is_pair (cvar), alist, pos, FUNC_NAME); \ |
| 270 | } while (0) |
| 271 | |
| 272 | #define SCM_VALIDATE_OPORT_VALUE(pos, port) \ |
| 273 | do { \ |
| 274 | SCM_ASSERT (scm_valid_oport_value_p (port), port, pos, FUNC_NAME); \ |
| 275 | } while (0) |
| 276 | |
| 277 | #define SCM_VALIDATE_PRINTSTATE(pos, a) SCM_MAKE_VALIDATE_MSG(pos, a, PRINT_STATE_P, "print-state") |
| 278 | |
| 279 | #define SCM_VALIDATE_SMOB(pos, obj, type) \ |
| 280 | do { \ |
| 281 | SCM_ASSERT (SCM_SMOB_PREDICATE (scm_tc16_ ## type, obj), \ |
| 282 | obj, pos, FUNC_NAME); \ |
| 283 | } while (0) |
| 284 | |
| 285 | #define SCM_VALIDATE_THUNK(pos, thunk) \ |
| 286 | do { \ |
| 287 | SCM_ASSERT (scm_is_true (scm_thunk_p (thunk)), thunk, pos, FUNC_NAME); \ |
| 288 | } while (0) |
| 289 | |
| 290 | #define SCM_VALIDATE_SYMBOL(pos, str) \ |
| 291 | do { \ |
| 292 | SCM_ASSERT_TYPE (scm_is_symbol (str), str, pos, FUNC_NAME, "symbol"); \ |
| 293 | } while (0) |
| 294 | |
| 295 | #define SCM_VALIDATE_VARIABLE(pos, var) SCM_MAKE_VALIDATE_MSG (pos, var, VARIABLEP, "variable") |
| 296 | |
| 297 | #define SCM_VALIDATE_MEMOIZED(pos, obj) SCM_MAKE_VALIDATE_MSG (pos, obj, MEMOIZED_P, "memoized code") |
| 298 | |
| 299 | #define SCM_VALIDATE_PROC(pos, proc) \ |
| 300 | do { \ |
| 301 | SCM_ASSERT (scm_is_true (scm_procedure_p (proc)), proc, pos, FUNC_NAME); \ |
| 302 | } while (0) |
| 303 | |
| 304 | #define SCM_VALIDATE_NULLORCONS(pos, env) \ |
| 305 | do { \ |
| 306 | SCM_ASSERT (scm_is_null (env) || scm_is_pair (env), env, pos, FUNC_NAME); \ |
| 307 | } while (0) |
| 308 | |
| 309 | #define SCM_VALIDATE_HOOK(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, HOOKP, "hook") |
| 310 | |
| 311 | #define SCM_VALIDATE_RGXP(pos, a) SCM_MAKE_VALIDATE_MSG (pos, a, RGXP, "regexp") |
| 312 | |
| 313 | #define SCM_VALIDATE_DIR(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, DIRP, "directory port") |
| 314 | |
| 315 | #define SCM_VALIDATE_PORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, PORTP, "port") |
| 316 | |
| 317 | #define SCM_VALIDATE_INPUT_PORT(pos, port) \ |
| 318 | SCM_MAKE_VALIDATE_MSG (pos, port, INPUT_PORT_P, "input port") |
| 319 | |
| 320 | #define SCM_VALIDATE_OUTPUT_PORT(pos, port) \ |
| 321 | SCM_MAKE_VALIDATE_MSG (pos, port, OUTPUT_PORT_P, "output port") |
| 322 | |
| 323 | #define SCM_VALIDATE_FPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, FPORTP, "file port") |
| 324 | |
| 325 | #define SCM_VALIDATE_OPFPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPFPORTP, "open file port") |
| 326 | |
| 327 | #define SCM_VALIDATE_OPINPORT(pos, port) \ |
| 328 | SCM_MAKE_VALIDATE_MSG (pos, port, OPINPORTP, "open input port") |
| 329 | |
| 330 | #define SCM_VALIDATE_OPENPORT(pos, port) \ |
| 331 | do { \ |
| 332 | SCM_ASSERT (SCM_PORTP (port) && SCM_OPENP (port), \ |
| 333 | port, pos, FUNC_NAME); \ |
| 334 | } while (0) |
| 335 | |
| 336 | #define SCM_VALIDATE_OPPORT(pos, port) SCM_MAKE_VALIDATE_MSG (pos, port, OPPORTP, "open port") |
| 337 | |
| 338 | #define SCM_VALIDATE_OPOUTPORT(pos, port) \ |
| 339 | SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTPORTP, "open output port") |
| 340 | |
| 341 | #define SCM_VALIDATE_OPOUTSTRPORT(pos, port) \ |
| 342 | SCM_MAKE_VALIDATE_MSG (pos, port, OPOUTSTRPORTP, "open output string port") |
| 343 | |
| 344 | #define SCM_VALIDATE_FLUID(pos, fluid) \ |
| 345 | SCM_I_MAKE_VALIDATE_MSG2 (pos, fluid, scm_is_fluid, "fluid") |
| 346 | |
| 347 | #define SCM_VALIDATE_KEYWORD(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, KEYWORDP, "keyword") |
| 348 | |
| 349 | #define SCM_VALIDATE_STACK(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STACKP, "stack") |
| 350 | |
| 351 | #define SCM_VALIDATE_FRAME(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, FRAMEP, "frame") |
| 352 | |
| 353 | #define SCM_VALIDATE_RSTATE(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, RSTATEP, "random-generator-state") |
| 354 | |
| 355 | #define SCM_VALIDATE_ARRAY(pos, v) \ |
| 356 | do { \ |
| 357 | SCM_ASSERT (SCM_HEAP_OBJECT_P (v) \ |
| 358 | && scm_is_true (scm_array_p (v, SCM_UNDEFINED)), \ |
| 359 | v, pos, FUNC_NAME); \ |
| 360 | } while (0) |
| 361 | |
| 362 | #define SCM_VALIDATE_VECTOR(pos, v) \ |
| 363 | do { \ |
| 364 | SCM_ASSERT (scm_is_simple_vector (v), v, pos, FUNC_NAME); \ |
| 365 | } while (0) |
| 366 | |
| 367 | #define SCM_VALIDATE_VECTOR_OR_DVECTOR(pos, v) \ |
| 368 | do { \ |
| 369 | SCM_ASSERT ((scm_is_simple_vector (v) \ |
| 370 | || (scm_is_true (scm_f64vector_p (v)))), \ |
| 371 | v, pos, FUNC_NAME); \ |
| 372 | } while (0) |
| 373 | |
| 374 | #define SCM_VALIDATE_STRUCT(pos, v) SCM_MAKE_VALIDATE_MSG (pos, v, STRUCTP, "struct") |
| 375 | |
| 376 | #define SCM_VALIDATE_VTABLE(pos, v) \ |
| 377 | do { \ |
| 378 | SCM_ASSERT (scm_is_true (scm_struct_vtable_p (v)), v, pos, FUNC_NAME); \ |
| 379 | } while (0) |
| 380 | |
| 381 | #define SCM_VALIDATE_VECTOR_LEN(pos, v, len) \ |
| 382 | do { \ |
| 383 | SCM_ASSERT (scm_is_vector (v) && len == scm_c_vector_length (v), v, pos, FUNC_NAME); \ |
| 384 | } while (0) |
| 385 | |
| 386 | |
| 387 | #endif /* SCM_VALIDATE_H */ |
| 388 | |
| 389 | /* |
| 390 | Local Variables: |
| 391 | c-file-style: "gnu" |
| 392 | End: |
| 393 | */ |