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:
Andy Wingo
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);
|
||||
switch (SCM_TYP7 (proc)) {
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
return SCM_SUBR_NAME (proc);
|
||||
default:
|
||||
{
|
||||
|
|
|
|||
|
|
@ -84,7 +84,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
|||
case scm_tc7_pws:
|
||||
case scm_tc7_program:
|
||||
case scm_tc7_bytevector:
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
case scm_tcs_struct:
|
||||
return SCM_BOOL_T;
|
||||
default:
|
||||
|
|
|
|||
|
|
@ -795,8 +795,8 @@ scm_i_tag_name (scm_t_bits tag)
|
|||
case scm_tc7_variable:
|
||||
return "variable";
|
||||
break;
|
||||
case scm_tcs_subrs:
|
||||
return "subrs";
|
||||
case scm_tc7_gsubr:
|
||||
return "gsubr";
|
||||
break;
|
||||
case scm_tc7_port:
|
||||
return "port";
|
||||
|
|
|
|||
|
|
@ -225,7 +225,6 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
|
|||
case scm_tc16_fraction:
|
||||
return scm_class_fraction;
|
||||
}
|
||||
case scm_tc7_cxr:
|
||||
case scm_tc7_gsubr:
|
||||
if (SCM_SUBR_GENERIC (x) && *SCM_SUBR_GENERIC (x))
|
||||
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
|
||||
* 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:
|
||||
return ((SCM_RDNG & SCM_CELL_WORD_0 (obj)) ? 260 : 261) % n;
|
||||
case scm_tcs_closures:
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
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
|
||||
|
||||
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 pair, SCM value),
|
||||
"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
|
||||
* case, when all remaining pairs of bits equal 00. */
|
||||
|
||||
typedef struct {
|
||||
const char *name;
|
||||
unsigned char pattern;
|
||||
} t_cxr;
|
||||
/* The compiler should unroll this. */
|
||||
#define CHASE_PAIRS(tree, FUNC_NAME, pattern) \
|
||||
scm_t_uint32 pattern_var = pattern; \
|
||||
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 */
|
||||
{"car", 0x03}, /* 00000011 */
|
||||
{"cddr", 0x0a}, /* 00001010 */
|
||||
{"cdar", 0x0b}, /* 00001011 */
|
||||
{"cadr", 0x0e}, /* 00001110 */
|
||||
{"caar", 0x0f}, /* 00001111 */
|
||||
{"cdddr", 0x2a}, /* 00101010 */
|
||||
{"cddar", 0x2b}, /* 00101011 */
|
||||
{"cdadr", 0x2e}, /* 00101110 */
|
||||
{"cdaar", 0x2f}, /* 00101111 */
|
||||
{"caddr", 0x3a}, /* 00111010 */
|
||||
{"cadar", 0x3b}, /* 00111011 */
|
||||
{"caadr", 0x3e}, /* 00111110 */
|
||||
{"caaar", 0x3f}, /* 00111111 */
|
||||
{"cddddr", 0xaa}, /* 10101010 */
|
||||
{"cdddar", 0xab}, /* 10101011 */
|
||||
{"cddadr", 0xae}, /* 10101110 */
|
||||
{"cddaar", 0xaf}, /* 10101111 */
|
||||
{"cdaddr", 0xba}, /* 10111010 */
|
||||
{"cdadar", 0xbb}, /* 10111011 */
|
||||
{"cdaadr", 0xbe}, /* 10111110 */
|
||||
{"cdaaar", 0xbf}, /* 10111111 */
|
||||
{"cadddr", 0xea}, /* 11101010 */
|
||||
{"caddar", 0xeb}, /* 11101011 */
|
||||
{"cadadr", 0xee}, /* 11101110 */
|
||||
{"cadaar", 0xef}, /* 11101111 */
|
||||
{"caaddr", 0xfa}, /* 11111010 */
|
||||
{"caadar", 0xfb}, /* 11111011 */
|
||||
{"caaadr", 0xfe}, /* 11111110 */
|
||||
{"caaaar", 0xff}, /* 11111111 */
|
||||
{0, 0}
|
||||
};
|
||||
CHASE_PAIRS (x, "cdr", 0x02); /* 00000010 */
|
||||
}
|
||||
SCM_DEFINE (scm_car, "car", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "car", 0x03); /* 00000011 */
|
||||
}
|
||||
SCM_DEFINE (scm_cddr, "cddr", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "cddr", 0x0a); /* 00001010 */
|
||||
}
|
||||
SCM_DEFINE (scm_cdar, "cdar", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "cdar", 0x0b); /* 00001011 */
|
||||
}
|
||||
SCM_DEFINE (scm_cadr, "cadr", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "cadr", 0x0e); /* 00001110 */
|
||||
}
|
||||
SCM_DEFINE (scm_caar, "caar", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "caar", 0x0f); /* 00001111 */
|
||||
}
|
||||
SCM_DEFINE (scm_cdddr, "cdddr", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "cdddr", 0x2a); /* 00101010 */
|
||||
}
|
||||
SCM_DEFINE (scm_cddar, "cddar", 1, 0, 0, (SCM x), "")
|
||||
{
|
||||
CHASE_PAIRS (x, "cddar", 0x2b); /* 00101011 */
|
||||
}
|
||||
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
|
||||
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"
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -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_cdr_x (SCM pair, SCM value);
|
||||
|
||||
#define SCM_I_D_PAT 0x02 /* 00000010 */
|
||||
#define SCM_I_A_PAT 0x03 /* 00000011 */
|
||||
#define SCM_I_DD_PAT 0x0a /* 00001010 */
|
||||
#define SCM_I_DA_PAT 0x0b /* 00001011 */
|
||||
#define SCM_I_AD_PAT 0x0e /* 00001110 */
|
||||
#define SCM_I_AA_PAT 0x0f /* 00001111 */
|
||||
#define SCM_I_DDD_PAT 0x2a /* 00101010 */
|
||||
#define SCM_I_DDA_PAT 0x2b /* 00101011 */
|
||||
#define SCM_I_DAD_PAT 0x2e /* 00101110 */
|
||||
#define SCM_I_DAA_PAT 0x2f /* 00101111 */
|
||||
#define SCM_I_ADD_PAT 0x3a /* 00111010 */
|
||||
#define SCM_I_ADA_PAT 0x3b /* 00111011 */
|
||||
#define SCM_I_AAD_PAT 0x3e /* 00111110 */
|
||||
#define SCM_I_AAA_PAT 0x3f /* 00111111 */
|
||||
#define SCM_I_DDDD_PAT 0xaa /* 10101010 */
|
||||
#define SCM_I_DDDA_PAT 0xab /* 10101011 */
|
||||
#define SCM_I_DDAD_PAT 0xae /* 10101110 */
|
||||
#define SCM_I_DDAA_PAT 0xaf /* 10101111 */
|
||||
#define SCM_I_DADD_PAT 0xba /* 10111010 */
|
||||
#define SCM_I_DADA_PAT 0xbb /* 10111011 */
|
||||
#define SCM_I_DAAD_PAT 0xbe /* 10111110 */
|
||||
#define SCM_I_DAAA_PAT 0xbf /* 10111111 */
|
||||
#define SCM_I_ADDD_PAT 0xea /* 11101010 */
|
||||
#define SCM_I_ADDA_PAT 0xeb /* 11101011 */
|
||||
#define SCM_I_ADAD_PAT 0xee /* 11101110 */
|
||||
#define SCM_I_ADAA_PAT 0xef /* 11101111 */
|
||||
#define SCM_I_AADD_PAT 0xfa /* 11111010 */
|
||||
#define SCM_I_AADA_PAT 0xfb /* 11111011 */
|
||||
#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_API SCM scm_cddr (SCM x);
|
||||
SCM_API SCM scm_cdar (SCM x);
|
||||
SCM_API SCM scm_cadr (SCM x);
|
||||
SCM_API SCM scm_caar (SCM x);
|
||||
SCM_API SCM scm_cdddr (SCM x);
|
||||
SCM_API SCM scm_cddar (SCM x);
|
||||
SCM_API SCM scm_cdadr (SCM x);
|
||||
SCM_API SCM scm_cdaar (SCM x);
|
||||
SCM_API SCM scm_caddr (SCM x);
|
||||
SCM_API SCM scm_cadar (SCM x);
|
||||
SCM_API SCM scm_caadr (SCM x);
|
||||
SCM_API SCM scm_caaar (SCM x);
|
||||
SCM_API SCM scm_cddddr (SCM x);
|
||||
SCM_API SCM scm_cdddar (SCM x);
|
||||
SCM_API SCM scm_cddadr (SCM x);
|
||||
SCM_API SCM scm_cddaar (SCM x);
|
||||
SCM_API SCM scm_cdaddr (SCM x);
|
||||
SCM_API SCM scm_cdadar (SCM x);
|
||||
SCM_API SCM scm_cdaadr (SCM x);
|
||||
SCM_API SCM scm_cdaaar (SCM x);
|
||||
SCM_API SCM scm_cadddr (SCM x);
|
||||
SCM_API SCM scm_caddar (SCM x);
|
||||
SCM_API SCM scm_cadadr (SCM x);
|
||||
SCM_API SCM scm_cadaar (SCM x);
|
||||
SCM_API SCM scm_caaddr (SCM x);
|
||||
SCM_API SCM scm_caadar (SCM x);
|
||||
SCM_API SCM scm_caaadr (SCM x);
|
||||
SCM_API SCM scm_caaaar (SCM x);
|
||||
|
||||
SCM_INTERNAL void scm_init_pairs (void);
|
||||
|
||||
|
|
|
|||
|
|
@ -782,7 +782,7 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
|
|||
}
|
||||
EXIT_NESTED_DATA (pstate);
|
||||
break;
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
{
|
||||
SCM name = scm_symbol_to_string (SCM_SUBR_NAME (exp));
|
||||
scm_puts (SCM_SUBR_GENERIC (exp)
|
||||
|
|
|
|||
|
|
@ -53,9 +53,6 @@ scm_i_procedure_arity (SCM proc)
|
|||
loop:
|
||||
switch (SCM_TYP7 (proc))
|
||||
{
|
||||
case scm_tc7_cxr:
|
||||
a += 1;
|
||||
break;
|
||||
case scm_tc7_program:
|
||||
if (scm_i_program_arity (proc, &a, &o, &r))
|
||||
break;
|
||||
|
|
|
|||
|
|
@ -101,7 +101,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0,
|
|||
|| SCM_STRUCT_APPLICABLE_P (obj)))
|
||||
break;
|
||||
case scm_tcs_closures:
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
case scm_tc7_pws:
|
||||
case scm_tc7_program:
|
||||
return SCM_BOOL_T;
|
||||
|
|
@ -163,7 +163,7 @@ scm_subr_p (SCM obj)
|
|||
if (SCM_NIMP (obj))
|
||||
switch (SCM_TYP7 (obj))
|
||||
{
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
return 1;
|
||||
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
|
||||
lookup */
|
||||
switch (SCM_TYP7 (procedure)) {
|
||||
case scm_tcs_subrs:
|
||||
case scm_tc7_gsubr:
|
||||
name = SCM_SUBR_NAME (procedure);
|
||||
break;
|
||||
default:
|
||||
|
|
|
|||
|
|
@ -431,7 +431,7 @@ typedef scm_t_uintptr scm_t_bits;
|
|||
#define scm_tc7_program 79
|
||||
#define scm_tc7_unused_9 85
|
||||
#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_12 101
|
||||
#define scm_tc7_unused_18 103
|
||||
|
|
@ -675,7 +675,6 @@ enum scm_tc8_tags
|
|||
/* For subrs
|
||||
*/
|
||||
#define scm_tcs_subrs \
|
||||
scm_tc7_cxr:\
|
||||
case scm_tc7_gsubr
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -277,9 +277,6 @@ apply_foreign (SCM proc, SCM *args, int nargs, int headroom)
|
|||
arglist = scm_cons (args[nargs], 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:
|
||||
if (!SCM_SMOB_APPLICABLE_P (proc))
|
||||
goto badproc;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue