diff options
author | Andy Wingo <wingo@pobox.com> | 2013-11-08 14:08:42 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-11-08 14:08:42 +0100 |
commit | 9f309e2cd9ec78408d2b0df77c46d44f7bddb368 (patch) | |
tree | f1b2f21d15b9b9dc85eb6d562c256be1b4156002 /libguile | |
parent | f41accb9c26e3b4df4170bda04b8860ee962657f (diff) | |
download | guile-9f309e2cd9ec78408d2b0df77c46d44f7bddb368.tar.gz |
Builtins have procedure properties
* libguile/vm-builtins.h (FOR_EACH_VM_BUILTIN): Add arity information.
(enum scm_vm_builtins):
* libguile/vm.c (scm_vm_builtin_ref):
(scm_vm_builtin_name_to_index):
(scm_vm_builtin_index_to_name): Adapt to macro interface change.
(scm_init_vm_builtin_properties): New helper, sets procedure
properties on builtins.
(scm_bootstrap_vm): Just define the builtins here. Later in the
bootstrap we set their properties.
(scm_sym_apply): Move definition here from expand.c.
* libguile/procprop.c (scm_init_procprop): Call
scm_init_vm_builtin_properties.
Diffstat (limited to 'libguile')
-rw-r--r-- | libguile/expand.c | 1 | ||||
-rw-r--r-- | libguile/procprop.c | 2 | ||||
-rw-r--r-- | libguile/vm-builtins.h | 13 | ||||
-rw-r--r-- | libguile/vm.c | 48 |
4 files changed, 40 insertions, 24 deletions
diff --git a/libguile/expand.c b/libguile/expand.c index a8625eafa..7d6a6ed32 100644 --- a/libguile/expand.c +++ b/libguile/expand.c @@ -173,7 +173,6 @@ SCM_SYNTAX ("case-lambda", expand_case_lambda); SCM_SYNTAX ("case-lambda*", expand_case_lambda_star); -SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply"); SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>"); SCM_GLOBAL_SYMBOL (scm_sym_at, "@"); SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@"); diff --git a/libguile/procprop.c b/libguile/procprop.c index 9965b451a..5bb9e6259 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -33,6 +33,7 @@ #include "libguile/vectors.h" #include "libguile/weak-table.h" #include "libguile/programs.h" +#include "libguile/vm-builtins.h" #include "libguile/validate.h" #include "libguile/procprop.h" @@ -342,6 +343,7 @@ scm_init_procprop () overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); arity_overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); #include "libguile/procprop.x" + scm_init_vm_builtin_properties (); } diff --git a/libguile/vm-builtins.h b/libguile/vm-builtins.h index c51174ca8..ea9b9e216 100644 --- a/libguile/vm-builtins.h +++ b/libguile/vm-builtins.h @@ -22,17 +22,17 @@ #ifdef BUILDING_LIBGUILE #define FOR_EACH_VM_BUILTIN(M) \ - M(apply, APPLY) \ - M(values, VALUES) \ - M(abort_to_prompt, ABORT_TO_PROMPT) \ - M(call_with_values, CALL_WITH_VALUES) \ - M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION) + M(apply, APPLY, 2, 0, 1) \ + M(values, VALUES, 0, 0, 1) \ + M(abort_to_prompt, ABORT_TO_PROMPT, 1, 0, 1) \ + M(call_with_values, CALL_WITH_VALUES, 2, 0, 0) \ + M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION, 1, 0, 0) /* These enumerated values are embedded in RTL code, and as such are part of Guile's ABI. */ enum scm_vm_builtins { -#define ENUM(builtin, BUILTIN) SCM_VM_BUILTIN_##BUILTIN, +#define ENUM(builtin, BUILTIN, req, opt, rest) SCM_VM_BUILTIN_##BUILTIN, FOR_EACH_VM_BUILTIN(ENUM) #undef ENUM SCM_VM_BUILTIN_COUNT @@ -40,6 +40,7 @@ enum scm_vm_builtins SCM_INTERNAL SCM scm_vm_builtin_name_to_index (SCM name); SCM_INTERNAL SCM scm_vm_builtin_index_to_name (SCM idx); +SCM_INTERNAL void scm_init_vm_builtin_properties (void); #endif /* BUILDING_LIBGUILE */ diff --git a/libguile/vm.c b/libguile/vm.c index bf1a269af..f87236e16 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -652,7 +652,7 @@ scm_vm_builtin_ref (unsigned idx) { switch (idx) { -#define INDEX_TO_NAME(builtin, BUILTIN) \ +#define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest) \ case SCM_VM_BUILTIN_##BUILTIN: return vm_builtin_##builtin; FOR_EACH_VM_BUILTIN(INDEX_TO_NAME) #undef INDEX_TO_NAME @@ -660,6 +660,7 @@ scm_vm_builtin_ref (unsigned idx) } } +SCM scm_sym_apply; static SCM scm_sym_values; static SCM scm_sym_abort_to_prompt; static SCM scm_sym_call_with_values; @@ -671,7 +672,7 @@ scm_vm_builtin_name_to_index (SCM name) { SCM_VALIDATE_SYMBOL (1, name); -#define NAME_TO_INDEX(builtin, BUILTIN) \ +#define NAME_TO_INDEX(builtin, BUILTIN, req, opt, rest) \ if (scm_is_eq (name, scm_sym_##builtin)) \ return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN); FOR_EACH_VM_BUILTIN(NAME_TO_INDEX) @@ -691,7 +692,7 @@ scm_vm_builtin_index_to_name (SCM index) switch (idx) { -#define INDEX_TO_NAME(builtin, BUILTIN) \ +#define INDEX_TO_NAME(builtin, BUILTIN, req, opt, rest) \ case SCM_VM_BUILTIN_##BUILTIN: return scm_sym_##builtin; FOR_EACH_VM_BUILTIN(INDEX_TO_NAME) #undef INDEX_TO_NAME @@ -703,12 +704,6 @@ scm_vm_builtin_index_to_name (SCM index) static void scm_init_vm_builtins (void) { - scm_sym_values = scm_from_utf8_symbol ("values"); - scm_sym_abort_to_prompt = scm_from_utf8_symbol ("abort-to-prompt"); - scm_sym_call_with_values = scm_from_utf8_symbol ("call-with-values"); - scm_sym_call_with_current_continuation = - scm_from_utf8_symbol ("call-with-current-continuation"); - scm_c_define_gsubr ("builtin-name->index", 1, 0, 0, scm_vm_builtin_name_to_index); scm_c_define_gsubr ("builtin-index->name", 1, 0, 0, @@ -1228,6 +1223,28 @@ make_boot_program (void) } void +scm_init_vm_builtin_properties (void) +{ + /* FIXME: Seems hacky to do this here, but oh well :/ */ + scm_sym_apply = scm_from_utf8_symbol ("apply"); + scm_sym_values = scm_from_utf8_symbol ("values"); + scm_sym_abort_to_prompt = scm_from_utf8_symbol ("abort-to-prompt"); + scm_sym_call_with_values = scm_from_utf8_symbol ("call-with-values"); + scm_sym_call_with_current_continuation = + scm_from_utf8_symbol ("call-with-current-continuation"); + +#define INIT_BUILTIN(builtin, BUILTIN, req, opt, rest) \ + scm_set_procedure_property_x (vm_builtin_##builtin, scm_sym_name, \ + scm_sym_##builtin); \ + scm_set_procedure_minimum_arity_x (vm_builtin_##builtin, \ + SCM_I_MAKINUM (req), \ + SCM_I_MAKINUM (opt), \ + scm_from_bool (rest)); + FOR_EACH_VM_BUILTIN (INIT_BUILTIN); +#undef INIT_BUILTIN +} + +void scm_bootstrap_vm (void) { scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION, @@ -1252,14 +1269,11 @@ scm_bootstrap_vm (void) SCM_SET_CELL_WORD_0 (rtl_boot_continuation, (SCM_CELL_WORD_0 (rtl_boot_continuation) | SCM_F_PROGRAM_IS_BOOT)); - vm_builtin_apply = scm_i_make_rtl_program (vm_builtin_apply_code); - vm_builtin_values = scm_i_make_rtl_program (vm_builtin_values_code); - vm_builtin_abort_to_prompt = - scm_i_make_rtl_program (vm_builtin_abort_to_prompt_code); - vm_builtin_call_with_values = - scm_i_make_rtl_program (vm_builtin_call_with_values_code); - vm_builtin_call_with_current_continuation = - scm_i_make_rtl_program (vm_builtin_call_with_current_continuation_code); + +#define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest) \ + vm_builtin_##builtin = scm_i_make_rtl_program (vm_builtin_##builtin##_code); + FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN); +#undef DEFINE_BUILTIN #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN vm_stack_gc_kind = |