Enrich type checking a bit to support some more ways of doing type ch…

…ecks.

src/6model/sixmodelobject.c

@@ -15,19 +15,21 @@ static INTVAL sc_id     = 0;
 /* Cached strings. */
 static STRING *find_method_str = NULL;
 static STRING *type_check_str = NULL;
+static STRING *accepts_type_str = NULL;
 
 /* Initializes 6model and produces the KnowHOW core meta-object. */
 void SixModelObject_initialize(PARROT_INTERP, PMC **knowhow, PMC **knowhow_attribute) {
     PMC    *initial_sc;
     STRING *initial_sc_name;
 
     /* Look up and cache some type IDs and strings. */
-    stable_id       = pmc_type(interp, Parrot_str_new(interp, "STable", 0));
-    repr_id         = pmc_type(interp, Parrot_str_new(interp, "REPR", 0));
-    smo_id          = pmc_type(interp, Parrot_str_new(interp, "SixModelObject", 0));
-    sc_id           = pmc_type(interp, Parrot_str_new(interp, "SerializationContext", 0));
-    find_method_str = Parrot_str_new_constant(interp, "find_method");
-    type_check_str  = Parrot_str_new_constant(interp, "type_check");
+    stable_id        = pmc_type(interp, Parrot_str_new(interp, "STable", 0));
+    repr_id          = pmc_type(interp, Parrot_str_new(interp, "REPR", 0));
+    smo_id           = pmc_type(interp, Parrot_str_new(interp, "SixModelObject", 0));
+    sc_id            = pmc_type(interp, Parrot_str_new(interp, "SerializationContext", 0));
+    find_method_str  = Parrot_str_new_constant(interp, "find_method");
+    type_check_str   = Parrot_str_new_constant(interp, "type_check");
+    accepts_type_str = Parrot_str_new_constant(interp, "accepts_type");
 
     /* Create initial core serialization context. */
     initial_sc = pmc_new(interp, sc_id);
@@ -98,30 +100,58 @@ static PMC * default_find_method(PARROT_INTERP, PMC *obj, STRING *name, INTVAL h
 /* This is the default type checking implementation. Note: it may also
  * be the only one we end up with since the HOW is the authority here.
  * So we may end up not calling this through the S-Table in the end. */
-static INTVAL default_type_check (PARROT_INTERP, PMC *obj, PMC *checkee) {
-    STable *st = STABLE(obj);
+static INTVAL default_type_check (PARROT_INTERP, PMC *to_check, PMC *wanted) {
+    PMC *HOW, *meth, *result;
+
+    STable *st = STABLE(to_check);
+    INTVAL type_check_mode = STABLE(wanted)->type_check_mode;
     if (st->type_check_cache) {
         /* We have the cache, so just look for the type object we
          * want to be in there. */
         INTVAL i;
         for (i = 0; i < st->type_check_cache_length; i++)
-            if (st->type_check_cache[i] == checkee)
+            if (st->type_check_cache[i] == wanted)
                 return 1;
-        return 0;
+
+        /* If the type check cache is definitive, we're done. */
+        if ((type_check_mode & TYPE_CHECK_CACHE_THEN_METHOD) == 0 &&
+                (type_check_mode & TYPE_CHECK_NEEDS_ACCEPTS) == 0)
+            return 0;
     }
-    else
+
+    /* If we get here, need to call .^type_check on the value we're
+     * checking. */
+    if (!st->type_check_cache || (type_check_mode & TYPE_CHECK_CACHE_THEN_METHOD))
     {
-        /* Find .^type_check and call it. */
-        PMC *HOW = st->HOW;
-        PMC *meth = STABLE(HOW)->find_method(interp, HOW, type_check_str, NO_HINT);
-        PMC *result;
+        PMC    *HOW = st->HOW;
+        PMC    *meth = STABLE(HOW)->find_method(interp, HOW, type_check_str, NO_HINT);
+        PMC    *result_pmc;
+        INTVAL  result;
         if (PMC_IS_NULL(meth)) {
             Parrot_ex_throw_from_c_args(interp, NULL, 1,
                 "No type check cache and no type_check method in meta-object");
         }
-        Parrot_ext_call(interp, meth, "PiPP->P", HOW, obj, checkee, &result);
-        return VTABLE_get_bool(interp, result);
+        Parrot_ext_call(interp, meth, "PiPP->P", HOW, to_check, wanted, &result_pmc);
+        result = VTABLE_get_bool(interp, result_pmc);
+        if (result)
+            return result;
+    }
+
+    /* If the flag to call .accepts_type on the target value is set, do so. */
+    if (type_check_mode & TYPE_CHECK_NEEDS_ACCEPTS) {
+        PMC    *HOW = STABLE(wanted)->HOW;
+        PMC    *meth = STABLE(HOW)->find_method(interp, HOW, accepts_type_str, NO_HINT);
+        PMC    *result_pmc;
+        if (PMC_IS_NULL(meth)) {
+            Parrot_ex_throw_from_c_args(interp, NULL, 1,
+                "Expected accepts_type method, but none found in meta-object");
+        }
+        Parrot_ext_call(interp, meth, "PiPP->P", HOW, wanted, to_check, &result_pmc);
+        return VTABLE_get_bool(interp, result_pmc);
     }
+
+    /* If we get here, type check failed. */
+    return 0;
 }
 
 /* Creates an STable that references the given REPR and HOW. */

src/6model/sixmodelobject.h

@@ -28,6 +28,18 @@ typedef struct {
     PMC                 *fetch_method;
 } ContainerSpec;
 
+/* Controls the way that type checks are performed. By default, if there is
+ * a type check cache we treat it as definitive. However, it's possible to
+ * declare that in the case the type check cache has no entry we should fall
+ * back to asking the .HOW.type_check method (set TYPE_CHECK_CACHE_THEN_METHOD).
+ * While a normal type check asks a value if it suppots another type, the
+ * TYPE_CHECK_NEEDS_ACCEPTS flag results in a call to .accepts_type on the
+ * HOW of the thing we're checking the value against, giving it a chance to
+ * decide answer. */
+#define TYPE_CHECK_CACHE_DEFINITIVE    0
+#define TYPE_CHECK_CACHE_THEN_METHOD   1
+#define TYPE_CHECK_NEEDS_ACCEPTS       2
+
 /* S-Tables (short for Shared Table) contains the commonalities shared between
  * a (HOW, REPR) pairing (for example, (HOW for the class Dog, P6Opaque). */
 typedef struct {
@@ -65,6 +77,9 @@ typedef struct {
 
     /* The length of the type check cache. */
     INTVAL type_check_cache_length;
+
+    /* The type checking mode (see flags for this above). */
+    INTVAL type_check_mode;
 
     /* An ID solely for use in caches that last a VM instance. Thus it
      * should never, ever be serialized and you should NEVER make a

src/ops/nqp.ops

@@ -718,9 +718,29 @@ inline op set_sub_multisig(in PMC, in PMC, in PMC) :base_core {
             "Can only use set_sub_multisig if first operand is a Sub.");
 }
 
+
+/*
+
+=item stable_set_type_check_mode()
+
+Sets the type check mode flags.
+
+=cut
+
+*/
+inline op stable_set_type_check_mode(in PMC, in INT) :base_core {
+    PMC *target = decontainerize(interp, $1);
+    if (target->vtable->base_type == smo_id)
+        STABLE(target)->type_check_mode = $2;
+    else
+        Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
+            "Can only use stable_set_type_check_mode with a SixModelObject");
+}
+
+
 /*
 
-=item publish_vtable_mapping()
+=item stable_publish_vtable_mapping()
 
 Publishes a Parrot v-table mapping, which will be hung off the s-table.
 It's stored as an array, so lookups will be speedy.