mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 11:50:28 +02:00
remove cxrs
* libguile/pairs.h: * libguile/pairs.c: Previously scm_cdadr et al were implemented as #defines that called scm_i_chase_pairs, and the Scheme-exposed functions themselves were cxr subrs, which got special help in the interpreter. Since now the special help is unnecessary (because the compiler inlines and expands calls to car, cdadr, etc), the complexity is a loss. So just implement cdadr etc using normal functions. There's an advantage too, in that the compiler can unroll the cxring, reducing branches. * libguile/tags.h (scm_tc7_cxr): Remove this tag. (scm_tcs_subrs): Now there's only one kind of subr, yay! * libguile/debug.c (scm_procedure_name) * libguile/evalext.c (scm_self_evaluating_p) * libguile/gc.c (scm_i_tag_name) * libguile/goops.c (scm_class_of) * libguile/hash.c (scm_hasher) * libguile/print.c (iprin1) * libguile/procprop.c (scm_i_procedure_arity) * libguile/procs.c (scm_procedure_p, scm_subr_p) (scm_make_procedure_with_setter) * libguile/vm.c (apply_foreign): Remove cxr cases. Replace uses of scm_tcs_subrs with scm_tc7_gsubr.
This commit is contained in:
parent
8a1f4f98e1
commit
f36878ba2d
12 changed files with 171 additions and 155 deletions
|
@ -138,7 +138,7 @@ SCM_DEFINE (scm_procedure_name, "procedure-name", 1, 0, 0,
|
||||||
{
|
{
|
||||||
SCM_VALIDATE_PROC (1, proc);
|
SCM_VALIDATE_PROC (1, proc);
|
||||||
switch (SCM_TYP7 (proc)) {
|
switch (SCM_TYP7 (proc)) {
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
return SCM_SUBR_NAME (proc);
|
return SCM_SUBR_NAME (proc);
|
||||||
default:
|
default:
|
||||||
{
|
{
|
||||||
|
|
|
@ -84,7 +84,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
||||||
case scm_tc7_pws:
|
case scm_tc7_pws:
|
||||||
case scm_tc7_program:
|
case scm_tc7_program:
|
||||||
case scm_tc7_bytevector:
|
case scm_tc7_bytevector:
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
case scm_tcs_struct:
|
case scm_tcs_struct:
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
default:
|
default:
|
||||||
|
|
|
@ -795,8 +795,8 @@ scm_i_tag_name (scm_t_bits tag)
|
||||||
case scm_tc7_variable:
|
case scm_tc7_variable:
|
||||||
return "variable";
|
return "variable";
|
||||||
break;
|
break;
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
return "subrs";
|
return "gsubr";
|
||||||
break;
|
break;
|
||||||
case scm_tc7_port:
|
case scm_tc7_port:
|
||||||
return "port";
|
return "port";
|
||||||
|
|
|
@ -225,7 +225,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
||||||
case scm_tc16_fraction:
|
case scm_tc16_fraction:
|
||||||
return scm_class_fraction;
|
return scm_class_fraction;
|
||||||
}
|
}
|
||||||
case scm_tc7_cxr:
|
|
||||||
case scm_tc7_gsubr:
|
case scm_tc7_gsubr:
|
||||||
if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
|
if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
|
||||||
return scm_class_primitive_generic;
|
return scm_class_primitive_generic;
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1997, 2000, 2001, 2003, 2004, 2006, 2008, 2009 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This library is free software; you can redistribute it and/or
|
* This library is free software; you can redistribute it and/or
|
||||||
* modify it under the terms of the GNU Lesser General Public License
|
* modify it under the terms of the GNU Lesser General Public License
|
||||||
|
@ -170,7 +170,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
|
||||||
case scm_tc7_port:
|
case scm_tc7_port:
|
||||||
return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
|
return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
|
||||||
case scm_tcs_closures:
|
case scm_tcs_closures:
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
return 262 % n;
|
return 262 % n;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
207
libguile/pairs.c
207
libguile/pairs.c
|
@ -96,36 +96,6 @@ SCM_DEFINE (scm_pair_p, "pair?", 1, 0, 0,
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
SCM
|
|
||||||
scm_car (SCM pair)
|
|
||||||
{
|
|
||||||
if (!scm_is_pair (pair))
|
|
||||||
scm_wrong_type_arg_msg (NULL, 0, pair, "pair");
|
|
||||||
return SCM_CAR (pair);
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
|
||||||
scm_cdr (SCM pair)
|
|
||||||
{
|
|
||||||
if (!scm_is_pair (pair))
|
|
||||||
scm_wrong_type_arg_msg (NULL, 0, pair, "pair");
|
|
||||||
return SCM_CDR (pair);
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM
|
|
||||||
scm_i_chase_pairs (SCM tree, scm_t_uint32 pattern)
|
|
||||||
{
|
|
||||||
do
|
|
||||||
{
|
|
||||||
if (!scm_is_pair (tree))
|
|
||||||
scm_wrong_type_arg_msg (NULL, 0, tree, "pair");
|
|
||||||
tree = (pattern & 1) ? SCM_CAR (tree) : SCM_CDR (tree);
|
|
||||||
pattern >>= 2;
|
|
||||||
}
|
|
||||||
while (pattern);
|
|
||||||
return tree;
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0,
|
SCM_DEFINE (scm_set_car_x, "set-car!", 2, 0, 0,
|
||||||
(SCM pair, SCM value),
|
(SCM pair, SCM value),
|
||||||
"Stores @var{value} in the car field of @var{pair}. The value returned\n"
|
"Stores @var{value} in the car field of @var{pair}. The value returned\n"
|
||||||
|
@ -159,59 +129,146 @@ SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
|
||||||
* two bits is only needed to indicate when cxr-ing is ready. This is the
|
* two bits is only needed to indicate when cxr-ing is ready. This is the
|
||||||
* case, when all remaining pairs of bits equal 00. */
|
* case, when all remaining pairs of bits equal 00. */
|
||||||
|
|
||||||
typedef struct {
|
/* The compiler should unroll this. */
|
||||||
const char *name;
|
#define CHASE_PAIRS(tree, FUNC_NAME, pattern) \
|
||||||
unsigned char pattern;
|
scm_t_uint32 pattern_var = pattern; \
|
||||||
} t_cxr;
|
do \
|
||||||
|
{ \
|
||||||
|
if (!scm_is_pair (tree)) \
|
||||||
|
scm_wrong_type_arg_msg (FUNC_NAME, 0, tree, "pair"); \
|
||||||
|
tree = (pattern_var & 1) ? SCM_CAR (tree) : SCM_CDR (tree); \
|
||||||
|
pattern_var >>= 2; \
|
||||||
|
} \
|
||||||
|
while (pattern_var); \
|
||||||
|
return tree
|
||||||
|
|
||||||
static const t_cxr cxrs[] =
|
|
||||||
|
SCM_DEFINE (scm_cdr, "cdr", 1, 0, 0, (SCM x), "")
|
||||||
{
|
{
|
||||||
{"cdr", 0x02}, /* 00000010 */
|
CHASE_PAIRS (x, "cdr", 0x02); /* 00000010 */
|
||||||
{"car", 0x03}, /* 00000011 */
|
}
|
||||||
{"cddr", 0x0a}, /* 00001010 */
|
SCM_DEFINE (scm_car, "car", 1, 0, 0, (SCM x), "")
|
||||||
{"cdar", 0x0b}, /* 00001011 */
|
{
|
||||||
{"cadr", 0x0e}, /* 00001110 */
|
CHASE_PAIRS (x, "car", 0x03); /* 00000011 */
|
||||||
{"caar", 0x0f}, /* 00001111 */
|
}
|
||||||
{"cdddr", 0x2a}, /* 00101010 */
|
SCM_DEFINE (scm_cddr, "cddr", 1, 0, 0, (SCM x), "")
|
||||||
{"cddar", 0x2b}, /* 00101011 */
|
{
|
||||||
{"cdadr", 0x2e}, /* 00101110 */
|
CHASE_PAIRS (x, "cddr", 0x0a); /* 00001010 */
|
||||||
{"cdaar", 0x2f}, /* 00101111 */
|
}
|
||||||
{"caddr", 0x3a}, /* 00111010 */
|
SCM_DEFINE (scm_cdar, "cdar", 1, 0, 0, (SCM x), "")
|
||||||
{"cadar", 0x3b}, /* 00111011 */
|
{
|
||||||
{"caadr", 0x3e}, /* 00111110 */
|
CHASE_PAIRS (x, "cdar", 0x0b); /* 00001011 */
|
||||||
{"caaar", 0x3f}, /* 00111111 */
|
}
|
||||||
{"cddddr", 0xaa}, /* 10101010 */
|
SCM_DEFINE (scm_cadr, "cadr", 1, 0, 0, (SCM x), "")
|
||||||
{"cdddar", 0xab}, /* 10101011 */
|
{
|
||||||
{"cddadr", 0xae}, /* 10101110 */
|
CHASE_PAIRS (x, "cadr", 0x0e); /* 00001110 */
|
||||||
{"cddaar", 0xaf}, /* 10101111 */
|
}
|
||||||
{"cdaddr", 0xba}, /* 10111010 */
|
SCM_DEFINE (scm_caar, "caar", 1, 0, 0, (SCM x), "")
|
||||||
{"cdadar", 0xbb}, /* 10111011 */
|
{
|
||||||
{"cdaadr", 0xbe}, /* 10111110 */
|
CHASE_PAIRS (x, "caar", 0x0f); /* 00001111 */
|
||||||
{"cdaaar", 0xbf}, /* 10111111 */
|
}
|
||||||
{"cadddr", 0xea}, /* 11101010 */
|
SCM_DEFINE (scm_cdddr, "cdddr", 1, 0, 0, (SCM x), "")
|
||||||
{"caddar", 0xeb}, /* 11101011 */
|
{
|
||||||
{"cadadr", 0xee}, /* 11101110 */
|
CHASE_PAIRS (x, "cdddr", 0x2a); /* 00101010 */
|
||||||
{"cadaar", 0xef}, /* 11101111 */
|
}
|
||||||
{"caaddr", 0xfa}, /* 11111010 */
|
SCM_DEFINE (scm_cddar, "cddar", 1, 0, 0, (SCM x), "")
|
||||||
{"caadar", 0xfb}, /* 11111011 */
|
{
|
||||||
{"caaadr", 0xfe}, /* 11111110 */
|
CHASE_PAIRS (x, "cddar", 0x2b); /* 00101011 */
|
||||||
{"caaaar", 0xff}, /* 11111111 */
|
}
|
||||||
{0, 0}
|
SCM_DEFINE (scm_cdadr, "cdadr", 1, 0, 0, (SCM x), "")
|
||||||
};
|
{
|
||||||
|
CHASE_PAIRS (x, "cdadr", 0x2e); /* 00101110 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cdaar, "cdaar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cdaar", 0x2f); /* 00101111 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caddr, "caddr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caddr", 0x3a); /* 00111010 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cadar, "cadar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cadar", 0x3b); /* 00111011 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caadr, "caadr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caadr", 0x3e); /* 00111110 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caaar, "caaar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caaar", 0x3f); /* 00111111 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cddddr, "cddddr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cddddr", 0xaa); /* 10101010 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cdddar, "cdddar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cdddar", 0xab); /* 10101011 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cddadr, "cddadr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cddadr", 0xae); /* 10101110 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cddaar, "cddaar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cddaar", 0xaf); /* 10101111 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cdaddr, "cdaddr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cdaddr", 0xba); /* 10111010 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cdadar, "cdadar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cdadar", 0xbb); /* 10111011 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cdaadr, "cdaadr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cdaadr", 0xbe); /* 10111110 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cdaaar, "cdaaar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cdaaar", 0xbf); /* 10111111 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cadddr, "cadddr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cadddr", 0xea); /* 11101010 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caddar, "caddar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caddar", 0xeb); /* 11101011 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cadadr, "cadadr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cadadr", 0xee); /* 11101110 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_cadaar, "cadaar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "cadaar", 0xef); /* 11101111 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caaddr, "caaddr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caaddr", 0xfa); /* 11111010 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caadar, "caadar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caadar", 0xfb); /* 11111011 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caaadr, "caaadr", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caaadr", 0xfe); /* 11111110 */
|
||||||
|
}
|
||||||
|
SCM_DEFINE (scm_caaaar, "caaaar", 1, 0, 0, (SCM x), "")
|
||||||
|
{
|
||||||
|
CHASE_PAIRS (x, "caaaar", 0xff); /* 11111111 */
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
void
|
void
|
||||||
scm_init_pairs ()
|
scm_init_pairs ()
|
||||||
{
|
{
|
||||||
unsigned int subnr = 0;
|
|
||||||
|
|
||||||
for (subnr = 0; cxrs[subnr].name; subnr++)
|
|
||||||
{
|
|
||||||
SCM (*pattern) () = (SCM (*) ()) (scm_t_bits) cxrs[subnr].pattern;
|
|
||||||
scm_c_define_subr (cxrs[subnr].name, scm_tc7_cxr, pattern);
|
|
||||||
}
|
|
||||||
|
|
||||||
#include "libguile/pairs.x"
|
#include "libguile/pairs.x"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -112,67 +112,34 @@ SCM_API SCM scm_cdr (SCM x);
|
||||||
SCM_API SCM scm_set_car_x (SCM pair, SCM value);
|
SCM_API SCM scm_set_car_x (SCM pair, SCM value);
|
||||||
SCM_API SCM scm_set_cdr_x (SCM pair, SCM value);
|
SCM_API SCM scm_set_cdr_x (SCM pair, SCM value);
|
||||||
|
|
||||||
#define SCM_I_D_PAT 0x02 /* 00000010 */
|
SCM_API SCM scm_cddr (SCM x);
|
||||||
#define SCM_I_A_PAT 0x03 /* 00000011 */
|
SCM_API SCM scm_cdar (SCM x);
|
||||||
#define SCM_I_DD_PAT 0x0a /* 00001010 */
|
SCM_API SCM scm_cadr (SCM x);
|
||||||
#define SCM_I_DA_PAT 0x0b /* 00001011 */
|
SCM_API SCM scm_caar (SCM x);
|
||||||
#define SCM_I_AD_PAT 0x0e /* 00001110 */
|
SCM_API SCM scm_cdddr (SCM x);
|
||||||
#define SCM_I_AA_PAT 0x0f /* 00001111 */
|
SCM_API SCM scm_cddar (SCM x);
|
||||||
#define SCM_I_DDD_PAT 0x2a /* 00101010 */
|
SCM_API SCM scm_cdadr (SCM x);
|
||||||
#define SCM_I_DDA_PAT 0x2b /* 00101011 */
|
SCM_API SCM scm_cdaar (SCM x);
|
||||||
#define SCM_I_DAD_PAT 0x2e /* 00101110 */
|
SCM_API SCM scm_caddr (SCM x);
|
||||||
#define SCM_I_DAA_PAT 0x2f /* 00101111 */
|
SCM_API SCM scm_cadar (SCM x);
|
||||||
#define SCM_I_ADD_PAT 0x3a /* 00111010 */
|
SCM_API SCM scm_caadr (SCM x);
|
||||||
#define SCM_I_ADA_PAT 0x3b /* 00111011 */
|
SCM_API SCM scm_caaar (SCM x);
|
||||||
#define SCM_I_AAD_PAT 0x3e /* 00111110 */
|
SCM_API SCM scm_cddddr (SCM x);
|
||||||
#define SCM_I_AAA_PAT 0x3f /* 00111111 */
|
SCM_API SCM scm_cdddar (SCM x);
|
||||||
#define SCM_I_DDDD_PAT 0xaa /* 10101010 */
|
SCM_API SCM scm_cddadr (SCM x);
|
||||||
#define SCM_I_DDDA_PAT 0xab /* 10101011 */
|
SCM_API SCM scm_cddaar (SCM x);
|
||||||
#define SCM_I_DDAD_PAT 0xae /* 10101110 */
|
SCM_API SCM scm_cdaddr (SCM x);
|
||||||
#define SCM_I_DDAA_PAT 0xaf /* 10101111 */
|
SCM_API SCM scm_cdadar (SCM x);
|
||||||
#define SCM_I_DADD_PAT 0xba /* 10111010 */
|
SCM_API SCM scm_cdaadr (SCM x);
|
||||||
#define SCM_I_DADA_PAT 0xbb /* 10111011 */
|
SCM_API SCM scm_cdaaar (SCM x);
|
||||||
#define SCM_I_DAAD_PAT 0xbe /* 10111110 */
|
SCM_API SCM scm_cadddr (SCM x);
|
||||||
#define SCM_I_DAAA_PAT 0xbf /* 10111111 */
|
SCM_API SCM scm_caddar (SCM x);
|
||||||
#define SCM_I_ADDD_PAT 0xea /* 11101010 */
|
SCM_API SCM scm_cadadr (SCM x);
|
||||||
#define SCM_I_ADDA_PAT 0xeb /* 11101011 */
|
SCM_API SCM scm_cadaar (SCM x);
|
||||||
#define SCM_I_ADAD_PAT 0xee /* 11101110 */
|
SCM_API SCM scm_caaddr (SCM x);
|
||||||
#define SCM_I_ADAA_PAT 0xef /* 11101111 */
|
SCM_API SCM scm_caadar (SCM x);
|
||||||
#define SCM_I_AADD_PAT 0xfa /* 11111010 */
|
SCM_API SCM scm_caaadr (SCM x);
|
||||||
#define SCM_I_AADA_PAT 0xfb /* 11111011 */
|
SCM_API SCM scm_caaaar (SCM x);
|
||||||
#define SCM_I_AAAD_PAT 0xfe /* 11111110 */
|
|
||||||
#define SCM_I_AAAA_PAT 0xff /* 11111111 */
|
|
||||||
|
|
||||||
SCM_API SCM scm_i_chase_pairs (SCM x, scm_t_uint32 pattern);
|
|
||||||
|
|
||||||
#define scm_cddr(x) scm_i_chase_pairs ((x), SCM_I_DD_PAT)
|
|
||||||
#define scm_cdar(x) scm_i_chase_pairs ((x), SCM_I_DA_PAT)
|
|
||||||
#define scm_cadr(x) scm_i_chase_pairs ((x), SCM_I_AD_PAT)
|
|
||||||
#define scm_caar(x) scm_i_chase_pairs ((x), SCM_I_AA_PAT)
|
|
||||||
#define scm_cdddr(x) scm_i_chase_pairs ((x), SCM_I_DDD_PAT)
|
|
||||||
#define scm_cddar(x) scm_i_chase_pairs ((x), SCM_I_DDA_PAT)
|
|
||||||
#define scm_cdadr(x) scm_i_chase_pairs ((x), SCM_I_DAD_PAT)
|
|
||||||
#define scm_cdaar(x) scm_i_chase_pairs ((x), SCM_I_DAA_PAT)
|
|
||||||
#define scm_caddr(x) scm_i_chase_pairs ((x), SCM_I_ADD_PAT)
|
|
||||||
#define scm_cadar(x) scm_i_chase_pairs ((x), SCM_I_ADA_PAT)
|
|
||||||
#define scm_caadr(x) scm_i_chase_pairs ((x), SCM_I_AAD_PAT)
|
|
||||||
#define scm_caaar(x) scm_i_chase_pairs ((x), SCM_I_AAA_PAT)
|
|
||||||
#define scm_cddddr(x) scm_i_chase_pairs ((x), SCM_I_DDDD_PAT)
|
|
||||||
#define scm_cdddar(x) scm_i_chase_pairs ((x), SCM_I_DDDA_PAT)
|
|
||||||
#define scm_cddadr(x) scm_i_chase_pairs ((x), SCM_I_DDAD_PAT)
|
|
||||||
#define scm_cddaar(x) scm_i_chase_pairs ((x), SCM_I_DDAA_PAT)
|
|
||||||
#define scm_cdaddr(x) scm_i_chase_pairs ((x), SCM_I_DADD_PAT)
|
|
||||||
#define scm_cdadar(x) scm_i_chase_pairs ((x), SCM_I_DADA_PAT)
|
|
||||||
#define scm_cdaadr(x) scm_i_chase_pairs ((x), SCM_I_DAAD_PAT)
|
|
||||||
#define scm_cdaaar(x) scm_i_chase_pairs ((x), SCM_I_DAAA_PAT)
|
|
||||||
#define scm_cadddr(x) scm_i_chase_pairs ((x), SCM_I_ADDD_PAT)
|
|
||||||
#define scm_caddar(x) scm_i_chase_pairs ((x), SCM_I_ADDA_PAT)
|
|
||||||
#define scm_cadadr(x) scm_i_chase_pairs ((x), SCM_I_ADAD_PAT)
|
|
||||||
#define scm_cadaar(x) scm_i_chase_pairs ((x), SCM_I_ADAA_PAT)
|
|
||||||
#define scm_caaddr(x) scm_i_chase_pairs ((x), SCM_I_AADD_PAT)
|
|
||||||
#define scm_caadar(x) scm_i_chase_pairs ((x), SCM_I_AADA_PAT)
|
|
||||||
#define scm_caaadr(x) scm_i_chase_pairs ((x), SCM_I_AAAD_PAT)
|
|
||||||
#define scm_caaaar(x) scm_i_chase_pairs ((x), SCM_I_AAAA_PAT)
|
|
||||||
|
|
||||||
SCM_INTERNAL void scm_init_pairs (void);
|
SCM_INTERNAL void scm_init_pairs (void);
|
||||||
|
|
||||||
|
|
|
@ -782,7 +782,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
||||||
}
|
}
|
||||||
EXIT_NESTED_DATA (pstate);
|
EXIT_NESTED_DATA (pstate);
|
||||||
break;
|
break;
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
{
|
{
|
||||||
SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp));
|
SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp));
|
||||||
scm_puts (SCM_SUBR_GENERIC (exp)
|
scm_puts (SCM_SUBR_GENERIC (exp)
|
||||||
|
|
|
@ -53,9 +53,6 @@ scm_i_procedure_arity (SCM proc)
|
||||||
loop:
|
loop:
|
||||||
switch (SCM_TYP7 (proc))
|
switch (SCM_TYP7 (proc))
|
||||||
{
|
{
|
||||||
case scm_tc7_cxr:
|
|
||||||
a += 1;
|
|
||||||
break;
|
|
||||||
case scm_tc7_program:
|
case scm_tc7_program:
|
||||||
if (scm_i_program_arity (proc, &a, &o, &r))
|
if (scm_i_program_arity (proc, &a, &o, &r))
|
||||||
break;
|
break;
|
||||||
|
|
|
@ -101,7 +101,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
|
||||||
|| SCM_STRUCT_APPLICABLE_P (obj)))
|
|| SCM_STRUCT_APPLICABLE_P (obj)))
|
||||||
break;
|
break;
|
||||||
case scm_tcs_closures:
|
case scm_tcs_closures:
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
case scm_tc7_pws:
|
case scm_tc7_pws:
|
||||||
case scm_tc7_program:
|
case scm_tc7_program:
|
||||||
return SCM_BOOL_T;
|
return SCM_BOOL_T;
|
||||||
|
@ -163,7 +163,7 @@ scm_subr_p (SCM obj)
|
||||||
if (SCM_NIMP (obj))
|
if (SCM_NIMP (obj))
|
||||||
switch (SCM_TYP7 (obj))
|
switch (SCM_TYP7 (obj))
|
||||||
{
|
{
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
return 1;
|
return 1;
|
||||||
default:
|
default:
|
||||||
;
|
;
|
||||||
|
@ -232,7 +232,7 @@ SCM_DEFINE (scm_make_procedure_with_setter, "make-procedure-with-setter", 2, 0,
|
||||||
/* don't use procedure_name, because don't care enough to do a reverse
|
/* don't use procedure_name, because don't care enough to do a reverse
|
||||||
lookup */
|
lookup */
|
||||||
switch (SCM_TYP7 (procedure)) {
|
switch (SCM_TYP7 (procedure)) {
|
||||||
case scm_tcs_subrs:
|
case scm_tc7_gsubr:
|
||||||
name = SCM_SUBR_NAME (procedure);
|
name = SCM_SUBR_NAME (procedure);
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
|
|
|
@ -431,7 +431,7 @@ typedef scm_t_uintptr scm_t_bits;
|
||||||
#define scm_tc7_program 79
|
#define scm_tc7_program 79
|
||||||
#define scm_tc7_unused_9 85
|
#define scm_tc7_unused_9 85
|
||||||
#define scm_tc7_unused_10 87
|
#define scm_tc7_unused_10 87
|
||||||
#define scm_tc7_cxr 93
|
#define scm_tc7_unused_20 93
|
||||||
#define scm_tc7_unused_11 95
|
#define scm_tc7_unused_11 95
|
||||||
#define scm_tc7_unused_12 101
|
#define scm_tc7_unused_12 101
|
||||||
#define scm_tc7_unused_18 103
|
#define scm_tc7_unused_18 103
|
||||||
|
@ -675,7 +675,6 @@ enum scm_tc8_tags
|
||||||
/* For subrs
|
/* For subrs
|
||||||
*/
|
*/
|
||||||
#define scm_tcs_subrs \
|
#define scm_tcs_subrs \
|
||||||
scm_tc7_cxr:\
|
|
||||||
case scm_tc7_gsubr
|
case scm_tc7_gsubr
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -277,9 +277,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
|
||||||
arglist = scm_cons (args[nargs], arglist);
|
arglist = scm_cons (args[nargs], arglist);
|
||||||
return scm_closure_apply (proc, arglist);
|
return scm_closure_apply (proc, arglist);
|
||||||
}
|
}
|
||||||
case scm_tc7_cxr:
|
|
||||||
if (nargs != 1) scm_wrong_num_args (proc);
|
|
||||||
return scm_i_chase_pairs (args[0], (scm_t_bits) SCM_SUBRF (proc));
|
|
||||||
case scm_tc7_smob:
|
case scm_tc7_smob:
|
||||||
if (!SCM_SMOB_APPLICABLE_P (proc))
|
if (!SCM_SMOB_APPLICABLE_P (proc))
|
||||||
goto badproc;
|
goto badproc;
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue