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.

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 =