[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 54/87: Cosmetic goops refactors.
From: |
Andy Wingo |
Subject: |
[Guile-commits] 54/87: Cosmetic goops refactors. |
Date: |
Thu, 22 Jan 2015 17:30:01 +0000 |
wingo pushed a commit to branch wip-goops-refactor
in repository guile.
commit 1d3b5985bee9e701afd4aa0f00e5e54ca0af8fb8
Author: Andy Wingo <address@hidden>
Date: Sun Jan 11 22:23:51 2015 +0100
Cosmetic goops refactors.
* module/oop/goops.scm: Update comments.
* libguile/goops.c: Cosmetic reorderings, re-commentings, and
de-commentings.
---
libguile/goops.c | 153 ++++++++++++++++++-------------------------------
module/oop/goops.scm | 33 ++++++++---
2 files changed, 80 insertions(+), 106 deletions(-)
diff --git a/libguile/goops.c b/libguile/goops.c
index 190b7e8..7a3b93b 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -151,6 +151,8 @@ SCM scm_i_port_class[3 * SCM_I_MAX_PORT_TYPE_COUNT];
/* SMOB classes. */
SCM scm_i_smob_class[SCM_I_MAX_SMOB_TYPE_COUNT];
+SCM scm_module_goops;
+
static SCM scm_make_unbound (void);
static SCM scm_unbound_p (SCM obj);
static SCM scm_class_p (SCM obj);
@@ -165,6 +167,33 @@ static SCM scm_sys_goops_loaded (void);
+SCM_DEFINE (scm_sys_make_root_class, "%make-root-class", 1, 0, 0,
+ (SCM layout),
+ "")
+#define FUNC_NAME s_scm_sys_make_root_class
+{
+ SCM z;
+
+ z = scm_i_make_vtable_vtable (layout);
+ SCM_SET_CLASS_FLAGS (z, (SCM_CLASSF_GOOPS_OR_VALID | SCM_CLASSF_METACLASS));
+
+ return z;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_sys_bless_applicable_struct_vtables_x,
"%bless-applicable-struct-vtables!", 2, 0, 0,
+ (SCM applicable, SCM setter),
+ "")
+#define FUNC_NAME s_scm_sys_bless_applicable_struct_vtables_x
+{
+ SCM_VALIDATE_CLASS (1, applicable);
+ SCM_VALIDATE_CLASS (2, setter);
+ SCM_SET_VTABLE_FLAGS (applicable, SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
+ SCM_SET_VTABLE_FLAGS (setter, SCM_VTABLE_FLAG_SETTER_VTABLE);
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
SCM
scm_make_standard_class (SCM meta, SCM name, SCM dsupers, SCM dslots)
{
@@ -315,25 +344,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
}
#undef FUNC_NAME
-/******************************************************************************/
-
-/******************************************************************************/
-
-SCM_DEFINE (scm_sys_make_root_class, "%make-root-class", 1, 0, 0,
- (SCM layout),
- "")
-#define FUNC_NAME s_scm_sys_make_root_class
-{
- SCM z;
-
- z = scm_i_make_vtable_vtable (layout);
- SCM_SET_CLASS_FLAGS (z, (SCM_CLASSF_GOOPS_OR_VALID | SCM_CLASSF_METACLASS));
-
- return z;
-}
-#undef FUNC_NAME
-/******************************************************************************/
+
SCM_DEFINE (scm_instance_p, "instance?", 1, 0, 0,
(SCM obj),
@@ -365,11 +377,8 @@ scm_is_method (SCM x)
return SCM_INSTANCEP (x) && SCM_SUBCLASSP (SCM_CLASS_OF (x), class_method);
}
-/******************************************************************************
- *
- * Meta object accessors
- *
-
******************************************************************************/
+
+
SCM
scm_class_name (SCM obj)
@@ -413,6 +422,9 @@ scm_class_slots (SCM obj)
return scm_call_1 (scm_variable_ref (var_class_slots), obj);
}
+
+
+
SCM_DEFINE (scm_generic_function_name, "generic-function-name", 1, 0, 0,
(SCM obj),
"Return the name of the generic function @var{obj}.")
@@ -447,11 +459,8 @@ scm_method_procedure (SCM obj)
return scm_call_1 (scm_variable_ref (var_method_procedure), obj);
}
-/******************************************************************************
- *
- * S l o t a c c e s s
- *
-
******************************************************************************/
+
+
SCM_DEFINE (scm_make_unbound, "make-unbound", 0, 0, 0,
(),
@@ -526,6 +535,9 @@ scm_slot_exists_p (SCM obj, SCM slot_name)
return scm_call_2 (scm_variable_ref (var_slot_exists_p), obj, slot_name);
}
+
+
+
SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 1, 0, 0,
(SCM obj),
"")
@@ -549,15 +561,12 @@ SCM_DEFINE (scm_sys_clear_fields_x, "%clear-fields!", 1,
0, 0,
}
#undef FUNC_NAME
-/******************************************************************************
- *
- * %modify-instance (used by change-class to modify in place)
- *
-
******************************************************************************/
+
+
SCM_DEFINE (scm_sys_modify_instance, "%modify-instance", 2, 0, 0,
(SCM old, SCM new),
- "")
+ "Used by change-class to modify objects in place.")
#define FUNC_NAME s_scm_sys_modify_instance
{
SCM_VALIDATE_INSTANCE (1, old);
@@ -686,21 +695,11 @@ scm_change_object_class (SCM obj, SCM old_class
SCM_UNUSED, SCM new_class)
}
}
-/******************************************************************************
- *
- * GGGG FFFFF
- * G F
- * G GG FFF
- * G G F
- * GGG E N E R I C F U N C T I O N S
- *
- * This implementation provides
- * - generic functions (with class specializers)
- * - multi-methods
- * - next-method
- * - a hard-coded MOP for standard gf, which can be overloaded for non-std
gf
- *
-
******************************************************************************/
+
+
+
+/* Primitive generics: primitives that can dispatch to generics if their
+ arguments fail to apply. */
SCM_DEFINE (scm_generic_capability_p, "generic-capability?", 1, 0, 0,
(SCM proc),
@@ -760,11 +759,6 @@ SCM_DEFINE (scm_primitive_generic_generic,
"primitive-generic-generic", 1, 0, 0,
}
#undef FUNC_NAME
-/* Dirk:FIXME:: In all of these scm_wta_dispatch_* routines it is
- * assumed that 'gf' is zero if uninitialized. It would be cleaner if
- * some valid SCM value like SCM_BOOL_F or SCM_UNDEFINED were chosen.
- */
-
SCM
scm_wta_dispatch_0 (SCM gf, const char *subr)
{
@@ -801,22 +795,8 @@ scm_wta_dispatch_n (SCM gf, SCM args, int pos, const char
*subr)
return scm_apply_0 (gf, args);
}
-/******************************************************************************
- *
- * Protocol for calling a generic fumction
- * This protocol is roughly equivalent to (parameter are a little bit different
- * for efficiency reasons):
- *
- * + apply-generic (gf args)
- * + compute-applicable-methods (gf args ...)
- * + sort-applicable-methods (methods args)
- * + apply-methods (gf methods args)
- *
- * apply-methods calls make-next-method to build the "continuation" of a a
- * method. Applying a next-method will call apply-next-method which in
- * turn will call apply again to call effectively the following method.
- *
-
******************************************************************************/
+
+
SCM_DEFINE (scm_make, "make", 0, 0, 1,
(SCM args),
@@ -829,11 +809,9 @@ SCM_DEFINE (scm_make, "make", 0, 0, 1,
#undef FUNC_NAME
-/**********************************************************************
- *
- * Smob classes
- *
- **********************************************************************/
+
+
+/* SMOB, struct, and port classes. */
static SCM
make_class_name (const char *prefix, const char *type_name, const char *suffix)
@@ -997,11 +975,8 @@ create_struct_classes (void)
vtable_class_map);
}
-/**********************************************************************
- *
- * C interface
- *
- **********************************************************************/
+
+
void
scm_load_goops ()
@@ -1031,22 +1006,8 @@ scm_ensure_accessor (SCM name)
return gf;
}
-/*
- * Initialization
- */
-SCM_DEFINE (scm_sys_bless_applicable_struct_vtables_x,
"%bless-applicable-struct-vtables!", 2, 0, 0,
- (SCM applicable, SCM setter),
- "")
-#define FUNC_NAME s_scm_sys_bless_applicable_struct_vtables_x
-{
- SCM_VALIDATE_CLASS (1, applicable);
- SCM_VALIDATE_CLASS (2, setter);
- SCM_SET_VTABLE_FLAGS (applicable, SCM_VTABLE_FLAG_APPLICABLE_VTABLE);
- SCM_SET_VTABLE_FLAGS (setter, SCM_VTABLE_FLAG_SETTER_VTABLE);
- return SCM_UNSPECIFIED;
-}
-#undef FUNC_NAME
+
SCM_DEFINE (scm_sys_goops_early_init, "%goops-early-init", 0, 0, 0,
(),
@@ -1175,8 +1136,6 @@ SCM_DEFINE (scm_sys_goops_loaded, "%goops-loaded", 0, 0,
0,
}
#undef FUNC_NAME
-SCM scm_module_goops;
-
static void
scm_init_goops_builtins (void *unused)
{
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 77450ca..74ca213 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -2582,15 +2582,30 @@ var{initargs}."
;;;
;;; {apply-generic}
;;;
-;;; Protocol for calling standard generic functions. This protocol is
-;;; not used for real <generic> functions (in this case we use a
-;;; completely C hard-coded protocol). Apply-generic is used by
-;;; goops for calls to subclasses of <generic> and <generic-with-setter>.
-;;; The code below is similar to the first MOP described in AMOP. In
-;;; particular, it doesn't used the currified approach to gf
-;;; call. There are 2 reasons for that:
-;;; - the protocol below is exposed to mimic completely the one written in C
-;;; - the currified protocol would be imho inefficient in C.
+;;; Protocol for calling generic functions, intended to be used when
+;;; applying subclasses of <generic> and <generic-with-setter>. The
+;;; code below is similar to the first MOP described in AMOP.
+;;;
+;;; Note that standard generic functions dispatch only on the classes of
+;;; the arguments, and the result of such dispatch can be memoized. The
+;;; `cache-dispatch' routine implements this. `apply-generic' isn't
+;;; called currently; the generic function MOP was never fully
+;;; implemented in GOOPS. However now that GOOPS is implemented
+;;; entirely in Scheme (2015) it's much easier to complete this work.
+;;; Contributions gladly accepted! Please read the AMOP first though :)
+;;;
+;;; The protocol is:
+;;;
+;;; + apply-generic (gf args)
+;;; + compute-applicable-methods (gf args ...)
+;;; + sort-applicable-methods (gf methods args)
+;;; + apply-methods (gf methods args)
+;;;
+;;; apply-methods calls make-next-method to build the "continuation" of
+;;; a method. Applying a next-method will call apply-next-method which
+;;; in turn will call apply again to call effectively the following
+;;; method. (This paragraph is out of date but is kept so that maybe it
+;;; illuminates some future hack.)
;;;
(define-method (apply-generic (gf <generic>) args)
- [Guile-commits] 43/87: Remove scm_c_extend_primitive_generic, (continued)
- [Guile-commits] 43/87: Remove scm_c_extend_primitive_generic, Andy Wingo, 2015/01/22
- [Guile-commits] 41/87: Remove TEST_CHANGE_CLASS, Andy Wingo, 2015/01/22
- [Guile-commits] 40/87: Remove pure-generic?, Andy Wingo, 2015/01/22
- [Guile-commits] 46/87: Deprecate scm_get_keyword, Andy Wingo, 2015/01/22
- [Guile-commits] 16/87: Fold GOOPS compile and dispatch modules into main GOOPS module, Andy Wingo, 2015/01/22
- [Guile-commits] 52/87: Remove special cases for <keyword>, Andy Wingo, 2015/01/22
- [Guile-commits] 53/87: Incorporate %inherit-magic! into %init-layout!, Andy Wingo, 2015/01/22
- [Guile-commits] 56/87: append-map rather than mapappend, Andy Wingo, 2015/01/22
- [Guile-commits] 55/87: GOOPS cleanup to use SRFI-1 better, Andy Wingo, 2015/01/22
- [Guile-commits] 48/87: Re-use the vtable "size" field for GOOPS nfields, Andy Wingo, 2015/01/22
- [Guile-commits] 54/87: Cosmetic goops refactors.,
Andy Wingo <=
- [Guile-commits] 47/87: Move <class> initialization to Scheme, Andy Wingo, 2015/01/22
- [Guile-commits] 50/87: Reimplement inherit-applicable! in Scheme, Andy Wingo, 2015/01/22
- [Guile-commits] 45/87: Rewrite %initialize-object in Scheme, Andy Wingo, 2015/01/22
- [Guile-commits] 49/87: Reimplement %allocate-instance in Scheme, Andy Wingo, 2015/01/22
- [Guile-commits] 51/87: goops.c no longer knows about <class> slot allocation, Andy Wingo, 2015/01/22
- [Guile-commits] 57/87: GOOPS utils module cleanups, Andy Wingo, 2015/01/22
- [Guile-commits] 58/87: Fold (oop goops util) into (oop goops), Andy Wingo, 2015/01/22
- [Guile-commits] 61/87: scm_make cleanup, Andy Wingo, 2015/01/22
- [Guile-commits] 60/87: Add compute-cpl tests, Andy Wingo, 2015/01/22
- [Guile-commits] 35/87: goops: use computed class slot offsets; untabify and fix whitepace, Andy Wingo, 2015/01/22