mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 19:50:24 +02:00
Code Activity

Builtins have procedure properties

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2013-11-08 14:08:42 +01:00
parent f41accb9c2
commit 9f309e2cd9
4 changed files with 40 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

1
libguile/expand.c
View file

@ -173,7 +173,6 @@ SCM_SYNTAX ("case-lambda", expand_case_lambda);
SCM_SYNTAX ("case-lambda*", expand_case_lambda_star); 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_arrow, "=>");
SCM_GLOBAL_SYMBOL (scm_sym_at, "@"); SCM_GLOBAL_SYMBOL (scm_sym_at, "@");
SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@"); SCM_GLOBAL_SYMBOL (scm_sym_atat, "@@");

2
libguile/procprop.c
View file

@ -33,6 +33,7 @@
#include "libguile/vectors.h" #include "libguile/vectors.h"
#include "libguile/weak-table.h" #include "libguile/weak-table.h"
#include "libguile/programs.h" #include "libguile/programs.h"
#include "libguile/vm-builtins.h"
#include "libguile/validate.h" #include "libguile/validate.h"
#include "libguile/procprop.h" #include "libguile/procprop.h"
@ -342,6 +343,7 @@ scm_init_procprop ()
overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY); 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); arity_overrides = scm_c_make_weak_table (0, SCM_WEAK_TABLE_KIND_KEY);
#include "libguile/procprop.x" #include "libguile/procprop.x"
scm_init_vm_builtin_properties ();
} }

13
libguile/vm-builtins.h
View file

@ -22,17 +22,17 @@
#ifdef BUILDING_LIBGUILE #ifdef BUILDING_LIBGUILE
#define FOR_EACH_VM_BUILTIN(M) \ #define FOR_EACH_VM_BUILTIN(M) \
M(apply, APPLY) \ M(apply, APPLY, 2, 0, 1) \
M(values, VALUES) \ M(values, VALUES, 0, 0, 1) \
M(abort_to_prompt, ABORT_TO_PROMPT) \ M(abort_to_prompt, ABORT_TO_PROMPT, 1, 0, 1) \
M(call_with_values, CALL_WITH_VALUES) \ M(call_with_values, CALL_WITH_VALUES, 2, 0, 0) \
M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION) M(call_with_current_continuation, CALL_WITH_CURRENT_CONTINUATION, 1, 0, 0)
/* These enumerated values are embedded in RTL code, and as such are /* These enumerated values are embedded in RTL code, and as such are
part of Guile's ABI. */ part of Guile's ABI. */
enum scm_vm_builtins 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) FOR_EACH_VM_BUILTIN(ENUM)
#undef ENUM #undef ENUM
SCM_VM_BUILTIN_COUNT 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_name_to_index (SCM name);
SCM_INTERNAL SCM scm_vm_builtin_index_to_name (SCM idx); SCM_INTERNAL SCM scm_vm_builtin_index_to_name (SCM idx);
SCM_INTERNAL void scm_init_vm_builtin_properties (void);
#endif /* BUILDING_LIBGUILE */ #endif /* BUILDING_LIBGUILE */

48
libguile/vm.c
View file

@ -652,7 +652,7 @@ scm_vm_builtin_ref (unsigned idx)
{ {
switch (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; case SCM_VM_BUILTIN_##BUILTIN: return vm_builtin_##builtin;
FOR_EACH_VM_BUILTIN(INDEX_TO_NAME) FOR_EACH_VM_BUILTIN(INDEX_TO_NAME)
#undef 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_values;
static SCM scm_sym_abort_to_prompt; static SCM scm_sym_abort_to_prompt;
static SCM scm_sym_call_with_values; static SCM scm_sym_call_with_values;
@ -671,7 +672,7 @@ scm_vm_builtin_name_to_index (SCM name)
{ {
SCM_VALIDATE_SYMBOL (1, 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)) \ if (scm_is_eq (name, scm_sym_##builtin)) \
return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN); return scm_from_uint (SCM_VM_BUILTIN_##BUILTIN);
FOR_EACH_VM_BUILTIN(NAME_TO_INDEX) FOR_EACH_VM_BUILTIN(NAME_TO_INDEX)
@ -691,7 +692,7 @@ scm_vm_builtin_index_to_name (SCM index)
switch (idx) 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; case SCM_VM_BUILTIN_##BUILTIN: return scm_sym_##builtin;
FOR_EACH_VM_BUILTIN(INDEX_TO_NAME) FOR_EACH_VM_BUILTIN(INDEX_TO_NAME)
#undef INDEX_TO_NAME #undef INDEX_TO_NAME
@ -703,12 +704,6 @@ scm_vm_builtin_index_to_name (SCM index)
static void static void
scm_init_vm_builtins (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_c_define_gsubr ("builtin-name->index", 1, 0, 0,
scm_vm_builtin_name_to_index); scm_vm_builtin_name_to_index);
scm_c_define_gsubr ("builtin-index->name", 1, 0, 0, scm_c_define_gsubr ("builtin-index->name", 1, 0, 0,
@ -1227,6 +1222,28 @@ make_boot_program (void)
return ret; return ret;
} }
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 void
scm_bootstrap_vm (void) scm_bootstrap_vm (void)
{ {
@ -1252,14 +1269,11 @@ scm_bootstrap_vm (void)
SCM_SET_CELL_WORD_0 (rtl_boot_continuation, SCM_SET_CELL_WORD_0 (rtl_boot_continuation,
(SCM_CELL_WORD_0 (rtl_boot_continuation) (SCM_CELL_WORD_0 (rtl_boot_continuation)
| SCM_F_PROGRAM_IS_BOOT)); | 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); #define DEFINE_BUILTIN(builtin, BUILTIN, req, opt, rest) \
vm_builtin_abort_to_prompt = vm_builtin_##builtin = scm_i_make_rtl_program (vm_builtin_##builtin##_code);
scm_i_make_rtl_program (vm_builtin_abort_to_prompt_code); FOR_EACH_VM_BUILTIN (DEFINE_BUILTIN);
vm_builtin_call_with_values = #undef DEFINE_BUILTIN
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);
#ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN #ifdef VM_ENABLE_PRECISE_STACK_GC_SCAN
vm_stack_gc_kind = vm_stack_gc_kind =