Implement TIP 524

1 files changed, 263 insertions, 0 deletions

diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c
index 6ee6188..14f80a4 100644
--- a/generic/tclOOCall.c
+++ b/generic/tclOOCall.c
@@ -31,6 +31,22 @@ struct ChainBuilder {
 };
 
 /*
+ * Structures used for traversing the class hierarchy to find out where
+ * definitions are supposed to be done.
+ */
+
+typedef struct {
+    Class *definerCls;
+    Tcl_Obj *namespaceName;
+} DefineEntry;
+
+typedef struct {
+    DefineEntry *list;
+    int num;
+    int size;
+} DefineChain;
+
+/*
  * Extra flags used for call chain management.
  */
 
@@ -77,6 +93,9 @@ static void		AddClassFiltersToCallContext(Object *const oPtr,
 static void		AddClassMethodNames(Class *clsPtr, const int flags,
 			    Tcl_HashTable *const namesPtr,
 			    Tcl_HashTable *const examinedClassesPtr);
+static inline void	AddDefinitionNamespaceToChain(Class *const definerCls,
+			    Tcl_Obj *const namespaceName,
+			    DefineChain *const definePtr, const int flags);
 static inline void	AddMethodToCallChain(Method *const mPtr,
 			    struct ChainBuilder *const cbPtr,
 			    Tcl_HashTable *const doneFilters,
@@ -105,6 +124,10 @@ static int		AddSimpleClassChainToCallContext(Class *classPtr,
 			    struct ChainBuilder *const cbPtr,
 			    Tcl_HashTable *const doneFilters, int flags,
 			    Class *const filterDecl);
+static void		AddSimpleClassDefineNamespaces(Class *classPtr,
+			    DefineChain *const definePtr, int flags);
+static inline void	AddSimpleDefineNamespaces(Object *const oPtr,
+			    DefineChain *const definePtr, int flags);
 static int		CmpStr(const void *ptr1, const void *ptr2);
 static void		DupMethodNameRep(Tcl_Obj *srcPtr, Tcl_Obj *dstPtr);
 static Tcl_NRPostProc	FinalizeMethodRefs;
@@ -1836,6 +1859,246 @@ TclOORenderCallChain(
 }
 
 /*
+ * ----------------------------------------------------------------------
+ *
+ * TclOOGetDefineContextNamespace --
+ *
+ *	Responsible for determining which namespace to use for definitions.
+ *	This is done by building a define chain, which models (strongly!) the
+ *	way that a call chain works but with a different internal model.
+ *
+ *	Then it walks the chain to find the first namespace name that actually
+ *	resolves to an existing namespace.
+ *
+ * Returns:
+ *	Name of namespace, or NULL if none can be found. Note that this
+ *	function does *not* set an error message in the interpreter on failure.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+#define DEFINE_CHAIN_STATIC_SIZE 4 /* Enough space to store most cases. */
+
+Tcl_Namespace *
+TclOOGetDefineContextNamespace(
+    Tcl_Interp *interp,		/* In what interpreter should namespace names
+				 * actually be resolved. */
+    Object *oPtr,		/* The object to get the context for. */
+    int forClass)		/* What sort of context are we looking for.
+				 * If true, we are going to use this for
+				 * [oo::define], otherwise, we are going to
+				 * use this for [oo::objdefine]. */
+{
+    DefineChain define;
+    DefineEntry staticSpace[DEFINE_CHAIN_STATIC_SIZE];
+    DefineEntry *entryPtr;
+    Tcl_Namespace *nsPtr = NULL;
+    int i;
+
+    define.list = staticSpace;
+    define.num = 0;
+    define.size = DEFINE_CHAIN_STATIC_SIZE;
+
+    /*
+     * Add the actual define locations. We have to do this twice to handle
+     * class mixins right.
+     */
+
+    AddSimpleDefineNamespaces(oPtr, &define, forClass | BUILDING_MIXINS);
+    AddSimpleDefineNamespaces(oPtr, &define, forClass);
+
+    /*
+     * Go through the list until we find a namespace whose name we can
+     * resolve.
+     */
+
+    FOREACH_STRUCT(entryPtr, define) {
+	if (TclGetNamespaceFromObj(interp, entryPtr->namespaceName,
+		&nsPtr) == TCL_OK) {
+	    break;
+	}
+	Tcl_ResetResult(interp);
+    }
+    if (define.list != staticSpace) {
+	ckfree(define.list);
+    }
+    return nsPtr;
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleDefineNamespaces --
+ *
+ *	Adds to the definition chain all the definitions provided by an
+ *	object's class and its mixins, taking into account everything they
+ *	inherit from.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddSimpleDefineNamespaces(
+    Object *const oPtr,		/* Object to add define chain entries for. */
+    DefineChain *const definePtr,
+				/* Where to add the define chain entries. */
+    int flags)			/* What sort of define chain are we
+				 * building. */
+{
+    Class *mixinPtr;
+    int i;
+
+    FOREACH(mixinPtr, oPtr->mixins) {
+	AddSimpleClassDefineNamespaces(mixinPtr, definePtr,
+		flags | TRAVERSED_MIXIN);
+    }
+
+    AddSimpleClassDefineNamespaces(oPtr->selfCls, definePtr, flags);
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddSimpleClassDefineNamespaces --
+ *
+ *	Adds to the definition chain all the definitions provided by a class
+ *	and its superclasses and its class mixins.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static void
+AddSimpleClassDefineNamespaces(
+    Class *classPtr,		/* Class to add the define chain entries for. */
+    DefineChain *const definePtr,
+				/* Where to add the define chain entries. */
+    int flags)			/* What sort of define chain are we
+				 * building. */
+{
+    int i;
+    Class *superPtr;
+
+    /*
+     * We hard-code the tail-recursive form. It's by far the most common case
+     * *and* it is much more gentle on the stack.
+     */
+
+  tailRecurse:
+    FOREACH(superPtr, classPtr->mixins) {
+	AddSimpleClassDefineNamespaces(superPtr, definePtr,
+		flags | TRAVERSED_MIXIN);
+    }
+
+    if (flags & ~(TRAVERSED_MIXIN | BUILDING_MIXINS)) {
+	AddDefinitionNamespaceToChain(classPtr, classPtr->clsDefinitionNs,
+		definePtr, flags);
+    } else {
+	AddDefinitionNamespaceToChain(classPtr, classPtr->objDefinitionNs,
+		definePtr, flags);
+    }	
+
+    switch (classPtr->superclasses.num) {
+    case 1:
+	classPtr = classPtr->superclasses.list[0];
+	goto tailRecurse;
+    default:
+	FOREACH(superPtr, classPtr->superclasses) {
+	    AddSimpleClassDefineNamespaces(superPtr, definePtr, flags);
+	}
+    case 0:
+	return;
+    }
+}
+
+/*
+ * ----------------------------------------------------------------------
+ *
+ * AddDefinitionNamespaceToChain --
+ *
+ *	Adds a single item to the definition chain (if it is meaningful),
+ *	reallocating the space for the chain if necessary.
+ *
+ * ----------------------------------------------------------------------
+ */
+
+static inline void
+AddDefinitionNamespaceToChain(
+    Class *definerCls,		/* What class defines this entry. */
+    Tcl_Obj *namespaceName,	/* The name for this entry (or NULL, a
+				 * no-op). */
+    DefineChain *const definePtr,
+				/* The define chain to add the method
+				 * implementation to. */
+    int flags)			/* Used to check if we're mixin-consistent
+				 * only. Mixin-consistent means that either
+				 * we're looking to add things from a mixin
+				 * and we have passed a mixin, or we're not
+				 * looking to add things from a mixin and have
+				 * not passed a mixin. */
+{
+    int i;
+
+    /*
+     * Return if this entry is blank. This is also where we enforce
+     * mixin-consistency.
+     */
+
+    if (namespaceName == NULL || !MIXIN_CONSISTENT(flags)) {
+	return;
+    }
+
+    /*
+     * First test whether the method is already in the call chain.
+     */
+
+    for (i=0 ; i<definePtr->num ; i++) {
+	if (definePtr->list[i].definerCls == definerCls) {
+	    /*
+	     * Call chain semantics states that methods come as *late* in the
+	     * call chain as possible. This is done by copying down the
+	     * following methods. Note that this does not change the number of
+	     * method invocations in the call chain; it just rearranges them.
+	     *
+	     * We skip changing anything if the place we found was already at
+	     * the end of the list.
+	     */
+
+	    if (i < definePtr->num - 1) {
+		memmove(&definePtr->list[i], &definePtr->list[i + 1],
+			sizeof(DefineEntry) * (definePtr->num - i - 1));
+		definePtr->list[i].definerCls = definerCls;
+		definePtr->list[i].namespaceName = namespaceName;
+	    }
+	    return;
+	}
+    }
+
+    /*
+     * Need to really add the define. This is made a bit more complex by the
+     * fact that we are using some "static" space initially, and only start
+     * realloc-ing if the chain gets long.
+     */
+
+    if (definePtr->num == definePtr->size) {
+	definePtr->size *= 2;
+	if (definePtr->num == DEFINE_CHAIN_STATIC_SIZE) {
+	    DefineEntry *staticList = definePtr->list;
+
+	    definePtr->list =
+		    ckalloc(sizeof(DefineEntry) * definePtr->size);
+	    memcpy(definePtr->list, staticList,
+		    sizeof(DefineEntry) * definePtr->num);
+	} else {
+	    definePtr->list = ckrealloc(definePtr->list,
+		    sizeof(DefineEntry) * definePtr->size);
+	}
+    }
+    definePtr->list[i].definerCls = definerCls;
+    definePtr->list[i].namespaceName = namespaceName;
+    definePtr->num++;
+}
+
+/*
  * Local Variables:
  * mode: c
  * c-basic-offset: 4