Implement interning, to pass 6pe tests.

Raku · Jan 23, 2015 · 44e9eb2 · 44e9eb2
1 parent 5feb90a
commit 44e9eb2
Showing 1 changed file with 49 additions and 21 deletions.
diff --git a/src/vm/parrot/ops/nqp.ops b/src/vm/parrot/ops/nqp.ops
@@ -4425,6 +4425,7 @@ inline op nqp_parameterizetype(out PMC, invar PMC, invar PMC) {
     if (type->vtable->base_type == smo_id) {
         PMC    *old_ctx, *cappy, *result;
         STable *new_stable;
+        INTVAL  i, j, num_lookups, params_elems, found;
 
         /* Ensure we have a parametric type. */
         STable *st = STABLE(type);
@@ -4433,29 +4434,56 @@ inline op nqp_parameterizetype(out PMC, invar PMC, invar PMC) {
                 "This type is not parametric");
 
         /* Do a lookup in the parameterizations array. */
-        /* XXX TODO */
+        found        = 0;
+        num_lookups  = VTABLE_elements(interp, st->paramet.ric.lookup);
+        params_elems = VTABLE_elements(interp, params);
+        for (i = 0; i < num_lookups; i += 2) {
+            PMC    *compare       = VTABLE_get_pmc_keyed_int(interp, st->paramet.ric.lookup, i);
+            INTVAL  compare_elems = VTABLE_elements(interp, compare);
+            if (params_elems == compare_elems) {
+                INTVAL match = 1;
+                for (j = 0; j < params_elems; j++) {
+                    PMC *want = VTABLE_get_pmc_keyed_int(interp, params, j);
+                    PMC *got  = VTABLE_get_pmc_keyed_int(interp, compare, j);
+                    /* XXX More cases to consider here. */
+                    if (want != got) {
+                        match = 0;
+                        break;
+                    }
+                }
+                if (match) {
+                    $1 = VTABLE_get_pmc_keyed_int(interp, st->paramet.ric.lookup, i + 1);
+                    found = 1;
+                    break;
+                }
+            }
+        }
 
         /* It wasn't found; run parameterizer. */
-        old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
-        cappy   = Parrot_pmc_new(interp, enum_class_CallContext);
-        VTABLE_push_pmc(interp, cappy, st->WHAT);
-        VTABLE_push_pmc(interp, cappy, params);
-        Parrot_pcc_invoke_from_sig_object(interp, st->paramet.ric.parameterizer, cappy);
-        cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
-        Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
-        result = VTABLE_get_pmc_keyed_int(interp, cappy, 0);
-
-        /* Mark parametric and stash required data. */
-        new_stable = STABLE(result);
-        new_stable->paramet.erized.parametric_type = st->WHAT;
-        new_stable->paramet.erized.parameters = params;
-        new_stable->mode_flags |= SM_PARAMETERIZED_TYPE;
-        PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC(result));
-
-        /* Add to lookup table. */
-        /* XXX TODO */
-
-        $1 = result;
+        if (!found) {
+            old_ctx = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
+            cappy   = Parrot_pmc_new(interp, enum_class_CallContext);
+            VTABLE_push_pmc(interp, cappy, st->WHAT);
+            VTABLE_push_pmc(interp, cappy, params);
+            Parrot_pcc_invoke_from_sig_object(interp, st->paramet.ric.parameterizer, cappy);
+            cappy = Parrot_pcc_get_signature(interp, CURRENT_CONTEXT(interp));
+            Parrot_pcc_set_signature(interp, CURRENT_CONTEXT(interp), old_ctx);
+            result = VTABLE_get_pmc_keyed_int(interp, cappy, 0);
+
+            /* Mark parametric and stash required data. */
+            new_stable = STABLE(result);
+            new_stable->paramet.erized.parametric_type = st->WHAT;
+            new_stable->paramet.erized.parameters = params;
+            new_stable->mode_flags |= SM_PARAMETERIZED_TYPE;
+            PARROT_GC_WRITE_BARRIER(interp, STABLE_PMC(result));
+
+            /* Add to lookup table. */
+            /* XXX handle possible race. */
+            VTABLE_push_pmc(interp, st->paramet.ric.lookup, params);
+            VTABLE_push_pmc(interp, st->paramet.ric.lookup, result);
+
+            $1 = result;
+        }
     }
     else {
         Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,