mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-23 13:00:34 +02:00
Code Activity

Preparation for more GOOPS refactorings

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2014-12-24 11:29:45 -05:00
parent 6ab1939653
commit 82ab50900a
2 changed files with 29 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

42
libguile/goops.c
View file

@ -172,6 +172,7 @@ static SCM scm_make_unbound (void);
static SCM scm_unbound_p (SCM obj); static SCM scm_unbound_p (SCM obj);
static SCM scm_assert_bound (SCM value, 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_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_sys_goops_loaded (void);
static SCM scm_make_extended_class_from_symbol (SCM type_name_sym, static SCM scm_make_extended_class_from_symbol (SCM type_name_sym,
int applicablep); int applicablep);
@ -2417,6 +2418,28 @@ SCM_DEFINE (scm_pure_generic_p, "pure-generic?", 1, 0, 0,
* Initialization * 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, SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0, 0,
(), (),
"Announce that GOOPS is loaded and perform initialization\n" "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); goops_rstate = scm_c_make_rstate ("GOOPS", 5);
hell = scm_calloc (hell_size * sizeof (*hell));
hell_mutex = scm_make_mutex ();
#include "libguile/goops.x" #include "libguile/goops.x"
var_compute_cpl = var_compute_cpl =
scm_module_variable (scm_module_goops, sym_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 ();
{
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);
}
} }
void void

3
module/oop/goops.scm
View file

@ -207,6 +207,9 @@
(use-modules ((language tree-il primitives) :select (add-interesting-primitive!))) (use-modules ((language tree-il primitives) :select (add-interesting-primitive!)))
(add-interesting-primitive! 'class-of)) (add-interesting-primitive! 'class-of))
(eval-when (compile load eval)
(%goops-early-init))
;; Then load the rest of GOOPS ;; Then load the rest of GOOPS
(use-modules (oop goops util) (use-modules (oop goops util)
(oop goops dispatch) (oop goops dispatch)