ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/microscheme/scheme.c
(Generate patch)

Comparing microscheme/scheme.c (file contents):
Revision 1.18 by root, Thu Nov 26 21:32:16 2015 UTC vs.
Revision 1.19 by root, Thu Nov 26 21:36:11 2015 UTC

… …
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
251INTERFACE int is_list (SCHEME_P_ pointer p); 251INTERFACE int is_list (SCHEME_P_ pointer p);
252
252INTERFACE INLINE int 253INTERFACE INLINE int
253is_vector (pointer p) 254is_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
5298typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes); 5299typedef pointer (*dispatch_func) (SCHEME_P_ enum scheme_opcodes);
5299 5300
5300typedef int (*test_predicate) (pointer); 5301typedef int (*test_predicate)(pointer);
5301static int 5302static int
5302is_any (pointer p) 5303is_any (pointer p)
5303{ 5304{
5304 return 1; 5305 return 1;
5305} 5306}
5306 5307
5307static int 5308static int
5308is_nonneg (pointer p) 5309is_nonneg (pointer p)
5309{ 5310{
5310 return ivalue (p) >= 0 && is_integer (p); 5311 return ivalue (p) >= 0 && is_integer (p);
5312}
5313
5314static int
5315tst_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! */
5314static struct 5321static 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);

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines