… | |
… | |
247 | |
247 | |
248 | #define strvalue(p) ((p)->object.string.svalue) |
248 | #define strvalue(p) ((p)->object.string.svalue) |
249 | #define strlength(p) ((p)->object.string.length) |
249 | #define strlength(p) ((p)->object.string.length) |
250 | |
250 | |
251 | INTERFACE int is_list (SCHEME_P_ pointer p); |
251 | INTERFACE int is_list (SCHEME_P_ pointer p); |
|
|
252 | |
252 | INTERFACE INLINE int |
253 | INTERFACE INLINE int |
253 | is_vector (pointer p) |
254 | is_vector (pointer p) |
254 | { |
255 | { |
255 | return type (p) == T_VECTOR; |
256 | return type (p) == T_VECTOR; |
256 | } |
257 | } |
… | |
… | |
5295 | abort (); |
5296 | abort (); |
5296 | } |
5297 | } |
5297 | |
5298 | |
5298 | typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes); |
5299 | typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes); |
5299 | |
5300 | |
5300 | typedef int (*test_predicate) (pointer); |
5301 | typedef int (*test_predicate)(pointer); |
5301 | static int |
5302 | static int |
5302 | is_any (pointer p) |
5303 | is_any (pointer p) |
5303 | { |
5304 | { |
5304 | return 1; |
5305 | return 1; |
5305 | } |
5306 | } |
5306 | |
5307 | |
5307 | static int |
5308 | static int |
5308 | is_nonneg (pointer p) |
5309 | is_nonneg (pointer p) |
5309 | { |
5310 | { |
5310 | return ivalue (p) >= 0 && is_integer (p); |
5311 | return ivalue (p) >= 0 && is_integer (p); |
|
|
5312 | } |
|
|
5313 | |
|
|
5314 | static int |
|
|
5315 | tst_is_list (pointer p) |
|
|
5316 | { |
|
|
5317 | return p == NIL || is_pair (p); |
5311 | } |
5318 | } |
5312 | |
5319 | |
5313 | /* Correspond carefully with following defines! */ |
5320 | /* Correspond carefully with following defines! */ |
5314 | static struct |
5321 | static struct |
5315 | { |
5322 | { |
5316 | test_predicate fct; |
5323 | test_predicate fct; |
5317 | const char *kind; |
5324 | const char *kind; |
5318 | } tests[] = |
5325 | } tests[] = |
5319 | { |
5326 | { |
5320 | { 0, 0}, /* unused */ |
5327 | { is_any, 0 }, |
5321 | { is_any, 0}, |
5328 | { is_string, "string" }, |
5322 | { is_string, "string" }, |
5329 | { is_symbol, "symbol" }, |
5323 | { is_symbol, "symbol" }, |
5330 | { is_port, "port" }, |
5324 | { is_port, "port" }, |
|
|
5325 | { is_inport, "input port" }, |
5331 | { is_inport, "input port" }, |
5326 | { is_outport, "output port" }, |
5332 | { is_outport, "output port" }, |
5327 | { is_environment, "environment" }, |
5333 | { is_environment, "environment" }, |
5328 | { is_pair, "pair" }, |
5334 | { is_pair, "pair" }, |
5329 | { 0, "pair or '()" }, |
5335 | { tst_is_list, "pair or '()" }, |
5330 | { is_character, "character" }, |
5336 | { is_character, "character" }, |
5331 | { is_vector, "vector" }, |
5337 | { is_vector, "vector" }, |
5332 | { is_number, "number" }, |
5338 | { is_number, "number" }, |
5333 | { is_integer, "integer" }, |
5339 | { is_integer, "integer" }, |
5334 | { is_nonneg, "non-negative integer" } |
5340 | { is_nonneg, "non-negative integer" } |
5335 | }; |
5341 | }; |
5336 | |
5342 | |
5337 | #define TST_NONE 0 /* TST_NONE used for standard procedures, for internal ops, 0 is used */ |
5343 | #define TST_NONE 0 /* TST_NONE used for standard procedures, for internal ops, 0 is used */ |
5338 | #define TST_ANY "\001" |
5344 | #define TST_ANY "\001" |
5339 | #define TST_STRING "\002" |
5345 | #define TST_STRING "\002" |
… | |
… | |
5424 | { |
5430 | { |
5425 | pointer arg = car (arglist); |
5431 | pointer arg = car (arglist); |
5426 | |
5432 | |
5427 | j = t[0]; |
5433 | j = t[0]; |
5428 | |
5434 | |
5429 | if (j == TST_LIST[0]) |
5435 | if (!tests[j - 1].fct (arg)) |
5430 | { |
|
|
5431 | if (arg != NIL && !is_pair (arg)) |
|
|
5432 | break; |
5436 | break; |
5433 | } |
|
|
5434 | else |
|
|
5435 | { |
|
|
5436 | if (!tests[j].fct (arg)) |
|
|
5437 | break; |
|
|
5438 | } |
|
|
5439 | |
5437 | |
5440 | if (t[1]) /* last test is replicated as necessary */ |
5438 | if (t[1]) /* last test is replicated as necessary */ |
5441 | t++; |
5439 | t++; |
5442 | |
5440 | |
5443 | arglist = cdr (arglist); |
5441 | arglist = cdr (arglist); |