Branch for adding a procedure->method primitive.
svn: r18489
This commit is contained in:
parent
911d80a144
commit
7aa99ae28a
File diff suppressed because it is too large
Load Diff
|
@ -167,6 +167,7 @@ static Scheme_Object *procedure_arity_p(int argc, Scheme_Object *argv[]);
|
|||
static Scheme_Object *procedure_arity_includes(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *procedure_reduce_arity(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *procedure_rename(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *procedure_to_method(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *procedure_equal_closure_p(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *primitive_p(int argc, Scheme_Object *argv[]);
|
||||
static Scheme_Object *primitive_closure_p(int argc, Scheme_Object *argv[]);
|
||||
|
@ -500,6 +501,11 @@ scheme_init_fun (Scheme_Env *env)
|
|||
"procedure-rename",
|
||||
2, 2),
|
||||
env);
|
||||
scheme_add_global_constant("procedure->method",
|
||||
scheme_make_prim_w_arity(procedure_to_method,
|
||||
"procedure->method",
|
||||
1, 1),
|
||||
env);
|
||||
scheme_add_global_constant("procedure-closure-contents-eq?",
|
||||
scheme_make_folding_prim(procedure_equal_closure_p,
|
||||
"procedure-closure-contents-eq?",
|
||||
|
@ -3839,6 +3845,16 @@ static Scheme_Object *procedure_rename(int argc, Scheme_Object *argv[])
|
|||
return make_reduced_proc(argv[0], aty, argv[1]);
|
||||
}
|
||||
|
||||
static Scheme_Object *procedure_to_method(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
Scheme_Object *p = argv[0];
|
||||
|
||||
if (!SCHEME_PROCP(p))
|
||||
scheme_wrong_type("procedure->method", "procedure", 0, argc, argv);
|
||||
|
||||
return p;
|
||||
}
|
||||
|
||||
static Scheme_Object *procedure_equal_closure_p(int argc, Scheme_Object *argv[])
|
||||
{
|
||||
Scheme_Object *v1 = argv[0], *v2 = argv[1];
|
||||
|
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
#define USE_COMPILED_STARTUP 1
|
||||
|
||||
#define EXPECTED_PRIM_COUNT 965
|
||||
#define EXPECTED_PRIM_COUNT 966
|
||||
#define EXPECTED_UNSAFE_COUNT 58
|
||||
#define EXPECTED_FLFXNUM_COUNT 53
|
||||
|
||||
|
|
|
@ -13,12 +13,12 @@
|
|||
consistently.)
|
||||
*/
|
||||
|
||||
#define MZSCHEME_VERSION "4.2.4.5"
|
||||
#define MZSCHEME_VERSION "4.2.4.6"
|
||||
|
||||
#define MZSCHEME_VERSION_X 4
|
||||
#define MZSCHEME_VERSION_Y 2
|
||||
#define MZSCHEME_VERSION_Z 4
|
||||
#define MZSCHEME_VERSION_W 5
|
||||
#define MZSCHEME_VERSION_W 6
|
||||
|
||||
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
|
||||
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)
|
||||
|
|
Loading…
Reference in New Issue
Block a user