suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Branch for adding a procedure->method primitive.

Browse Source 
svn: r18489
This commit is contained in:
Stevie Strickland 2010-03-08 21:48:25 +00:00
parent 911d80a144
commit 7aa99ae28a
4 changed files with 623 additions and 532 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1133
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

16
src/mzscheme/src/fun.c
View File

@ -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_arity_includes(int argc, Scheme_Object *argv[]);
static Scheme_Object *procedure_reduce_arity(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_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 *procedure_equal_closure_p(int argc, Scheme_Object *argv[]);
static Scheme_Object *primitive_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[]); static Scheme_Object *primitive_closure_p(int argc, Scheme_Object *argv[]);
@ -500,6 +501,11 @@ scheme_init_fun (Scheme_Env *env)
"procedure-rename", "procedure-rename",
2, 2), 2, 2),
env); 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_add_global_constant("procedure-closure-contents-eq?",
scheme_make_folding_prim(procedure_equal_closure_p, scheme_make_folding_prim(procedure_equal_closure_p,
"procedure-closure-contents-eq?", "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]); 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[]) static Scheme_Object *procedure_equal_closure_p(int argc, Scheme_Object *argv[])
{ {
Scheme_Object *v1 = argv[0], *v2 = argv[1]; Scheme_Object *v1 = argv[0], *v2 = argv[1];

2
src/mzscheme/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1 #define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 965 #define EXPECTED_PRIM_COUNT 966
#define EXPECTED_UNSAFE_COUNT 58 #define EXPECTED_UNSAFE_COUNT 58
#define EXPECTED_FLFXNUM_COUNT 53 #define EXPECTED_FLFXNUM_COUNT 53

4
src/mzscheme/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "4.2.4.5" #define MZSCHEME_VERSION "4.2.4.6"
#define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_X 4
#define MZSCHEME_VERSION_Y 2 #define MZSCHEME_VERSION_Y 2
#define MZSCHEME_VERSION_Z 4 #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_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)