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