[Guile-commits] 08/87: Preparation for more GOOPS refactorings

[Andy Wingo]

wingo pushed a commit to branch wip-goops-refactor
in repository guile.

commit 8701c2cd82797608f76cdd57b400c84dd3f34db0
Author: Andy Wingo <address@hidden>
Date:   Wed Dec 24 11:29:45 2014 -0500

    Preparation for more GOOPS refactorings
    
    * libguile/goops.c (scm_sys_goops_early_init)
      (scm_init_goops_builtins): Factor out some initialization to a
      separate helper.  This will be the base for moving more things from C
      to Scheme in the future.
    
    * module/oop/goops.scm: Call %goops-early-init.
---
 libguile/goops.c     |   42 ++++++++++++++++++++++++++----------------
 module/oop/goops.scm |    3 +++
 2 files changed, 29 insertions(+), 16 deletions(-)

diff --git a/libguile/goops.c b/libguile/goops.c
index 0b3f30a..e12b580 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -172,6 +172,7 @@ static SCM scm_make_unbound (void);
 static SCM scm_unbound_p (SCM obj);
 static SCM scm_assert_bound (SCM value, SCM obj);
 static SCM scm_at_assert_bound_ref (SCM obj, SCM index);
+static SCM scm_sys_goops_early_init (void);
 static SCM scm_sys_goops_loaded (void);
 static SCM scm_make_extended_class_from_symbol (SCM type_name_sym, 
                                                int applicablep);
@@ -2417,6 +2418,28 @@ SCM_DEFINE (scm_pure_generic_p, "pure-generic?", 1, 0, 0,
  * Initialization
  */
 
+SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
+           (),
+           "")
+#define FUNC_NAME s_scm_sys_goops_early_init
+{
+  create_basic_classes ();
+  create_standard_classes ();
+  create_smob_classes ();
+  create_struct_classes ();
+  create_port_classes ();
+
+  {
+    SCM name = scm_from_latin1_symbol ("no-applicable-method");
+    scm_no_applicable_method =
+      scm_make (scm_list_3 (scm_class_generic, k_name, name));
+    scm_module_define (scm_module_goops, name, scm_no_applicable_method);
+  }
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
            (),
            "Announce that GOOPS is loaded and perform initialization\n"
@@ -2446,26 +2469,13 @@ scm_init_goops_builtins (void *unused)
 
   goops_rstate = scm_c_make_rstate ("GOOPS", 5);
 
-#include "libguile/goops.x"
-
-  var_compute_cpl =
-    scm_module_variable (scm_module_goops, sym_compute_cpl);
-
   hell = scm_calloc (hell_size * sizeof (*hell));
   hell_mutex = scm_make_mutex ();
 
-  create_basic_classes ();
-  create_standard_classes ();
-  create_smob_classes ();
-  create_struct_classes ();
-  create_port_classes ();
+#include "libguile/goops.x"
 
-  {
-    SCM name = scm_from_latin1_symbol ("no-applicable-method");
-    scm_no_applicable_method =
-      scm_make (scm_list_3 (scm_class_generic, k_name, name));
-    scm_module_define (scm_module_goops, name, scm_no_applicable_method);
-  }
+  var_compute_cpl =
+    scm_module_variable (scm_module_goops, sym_compute_cpl);
 }
 
 void
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index dfe4d6c..efa9f03 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -207,6 +207,9 @@
   (use-modules ((language tree-il primitives) :select 
(add-interesting-primitive!)))
   (add-interesting-primitive! 'class-of))
 
+(eval-when (compile load eval)
+  (%goops-early-init))
+
 ;; Then load the rest of GOOPS
 (use-modules (oop goops util)
             (oop goops dispatch)