Code to support the relation kind.

§1. Block Format. Inform uses a rich variety of relations, with many different data representations, but we aim to hide that complexity from the user. At run-time, a relation is represented by a block value. The short block of this BV is simply a pointer to a long block. This always begins with at least six words of metadata, but actual data sometimes follows on, and sometimes doesn't: and its format is something the customer needn't know about.

The low-level routines in "Relations.i6t" access this metadata by direct use of -->, for speed, and they use the offset constants RR_NAME and so on; but we will use the PVField and WritePVField routines in this section, which need offsets in the form RRV_NAME. (The discrepancy of 5 is to allow for the five-word block header.) 

Constant RRV_NAME           RR_NAME-5;        Packed string, e.g. "containment relation"
Constant RRV_PERMISSIONS    RR_PERMISSIONS-5; A bitmap of what operations this supports
Constant RRV_STORAGE        RR_STORAGE-5;     Data location, depending on format
Constant RRV_KIND           RR_KIND-5;        Strong kind ID of the relation
Constant RRV_HANDLER        RR_HANDLER-5;     Routine to perform operations on this
Constant RRV_DESCRIPTION    RR_DESCRIPTION-5; Packed string, e.g. "contains"
Constant RRV_USED           6;
Constant RRV_FILLED         7;
Constant RRV_DATA_BASE      8;

§2. Other Definitions. 

valencies
Constant RRVAL_V_TO_V       0;
Constant RRVAL_V_TO_O       RELS_Y_UNIQUE;
Constant RRVAL_O_TO_V       RELS_X_UNIQUE;
Constant RRVAL_O_TO_O       RELS_X_UNIQUE+RELS_Y_UNIQUE;
Constant RRVAL_EQUIV        RELS_EQUIVALENCE+RELS_SYMMETRIC;
Constant RRVAL_SYM_V_TO_V   RELS_SYMMETRIC;
Constant RRVAL_SYM_O_TO_O   RELS_SYMMETRIC+RELS_X_UNIQUE+RELS_Y_UNIQUE;

dictionary entry flags
Constant RRF_USED       $0001;  entry contains a value
Constant RRF_DELETED    $0002;  entry used to contain a value
Constant RRF_SINGLE     $0004;  entry's Y is a value, not a list
Constant RRF_HASX       $0010;  2-in-1 entry contains a corresponding key
Constant RRF_HASY       $0020;  2-in-1 entry contains a corresponding value
Constant RRF_ENTKEYX    $0040;  2-in-1 entry key is left side KOV
Constant RRF_ENTKEYY    $0080;  2-in-1 entry key is right side KOV

permission/task constants (those commented out here are generated by I7)
onstant RELS_SYMMETRIC $8000;
onstant RELS_EQUIVALENCE $4000;
onstant RELS_X_UNIQUE $2000;
onstant RELS_Y_UNIQUE $1000;
onstant RELS_TEST $0800;
onstant RELS_ASSERT_TRUE $0400;
onstant RELS_ASSERT_FALSE $0200;
onstant RELS_SHOW $0100;
onstant RELS_ROUTE_FIND $0080;
onstant RELS_ROUTE_FIND_COUNT $0040;
Constant RELS_COPY $0020;
Constant RELS_DESTROY $0010;
onstant RELS_LOOKUP_ANY $0008;
onstant RELS_LOOKUP_ALL_X $0004;
onstant RELS_LOOKUP_ALL_Y $0002;
onstant RELS_LIST $0001;

Constant RELS_EMPTY $0003;
Constant RELS_SET_VALENCY $0005;

RELS_LOOKUP_ANY mode selection constants
Constant RLANY_GET_X 1;
Constant RLANY_GET_Y 2;
Constant RLANY_CAN_GET_X 3;
Constant RLANY_CAN_GET_Y 4;

RELS_LIST mode selection constant
Constant RLIST_ALL_X 1;
Constant RLIST_ALL_Y 2;
Constant RLIST_ALL_PAIRS 3;

§3. Tunable Parameters. These constants affect the performance characteristics of the dictionary structures used for relations on the heap. Changing their values may alter the balance between memory consumption and running time.

RRP_MIN_SIZE, RRP_RESIZE_SMALL, and RRP_RESIZE_LARGE must all be powers of two. 

Constant RRP_MIN_SIZE      8;   minimum number of entries (DO NOT CHANGE)
Constant RRP_PERTURB_SHIFT 5;   affects the probe sequence
Constant MINUS_RRP_PERTURB_SHIFT -5;   affects the probe sequence
Constant RRP_RESIZE_SMALL  4;   resize factor for small tables
Constant RRP_RESIZE_LARGE  2;   resize factor for large tables
Constant RRP_LARGE_IS      256; how many entries make a table "large"?
Constant RRP_CROWDED_IS    2;   when filled entries outnumber unfilled by _ to 1

§4. Abstract Relations. As the following shows, we can abstractly use a relation — that is, we can use a relation whose identity we know little about — by calling its handler routine R in the form R(rel, task, X, Y).

The task should be one of: RELS_TEST, RELS_ASSERT_TRUE, RELS_ASSERT_FALSE, RELS_SHOW, RELS_ROUTE_FIND, RELS_ROUTE_FIND_COUNT, RELS_COPY, RELS_DESTROY, RELS_LOOKUP_ANY, RELS_LOOKUP_ALL_X, RELS_LOOKUP_ALL_Y, RELS_LIST, or RELS_EMPTY.

RELS_SHOW produces output for the SHOWME testing command. RELS_ROUTE_FIND finds the next step in a route from X to Y, and RELS_ROUTE_FIND_COUNT counts the shortest number of steps or returns \(-1\) if no route exists. RELS_COPY makes a deep copy of the relation by replacing all block values with duplicates, and RELS_DESTROY frees all block values. RELS_LOOKUP_ANY finds any one of the X values related to a given Y, or vice versa, or checks whether such an X or Y value exists. RELS_LOOKUP_ALL_X and RELS_LOOKUP_ALL_Y produce a list of all the X values related to a given Y, or vice versa. RELS_LIST produces a list of all X values for which a corresponding Y exists, or vice versa, or a list of all (X,Y) pairs for which X is related to Y. RELS_EMPTY either makes the relation empty (if X is 1) or non-empty (if X is 0) or makes no change (if X is negative), and in any case returns true or false indicating whether the relation is now empty.

Because not every relation supports all of these operations, the "permissions" word in the block is always a bitmap which is a sum of those operations it does offer.

At present, these permissions are not checked as rigorously as they should be (they're correctly set, but not much monitored). 

[ RelationTest relation task X Y  handler;
    handler = RlnGetF(relation, RR_HANDLER);
    return handler(relation, task, X, Y);
];

[ RlnGetF rel fld i;
    rel = BlkValueGetLongBlock(rel);
    return rel-->fld;
];

[ RlnSetF rel fld v;
    rel = BlkValueGetLongBlock(rel);
    rel-->fld = v;
];

§5. Empty Relations. The absolute minimum relation is one which can only be tested, and which is always empty, that is, where no two values are ever related to each other. The necessary handler routine is EmptyRelationHandler. 

[ EmptyRelationHandler relation task X Y;
    if (task == RELS_EMPTY) rtrue;
    rfalse;
];

§6. Creation. Something we have to be careful about is what we mean by copying, or indeed creating, a relation. For example, if we write

let Q be a relation of objects to objects;

let Q be the containment relation;

...we aren't literally asking for Q to be a duplicate copy of containment, which can then independently evolve — we mean in some sense that Q is a pointer to the one and only containment relation. On the other hand, if we write

let Q be a relation of numbers to numbers;

make Q relate 3 to 7;

then the second line clearly expects Q to be its own relation, newly created.

We cope with this at creation time. If we're invited to create a copy of an existing relation, we look to see if it is empty — which we detect by its use of the EmptyRelationHandler handler. The empty relations are exactly those used as default values for the relation kinds; thus that's what will happen when Q is created. If we find this handler, we intercept and replace it with one of the heap relation handlers, which thus makes the relation a newly constructed data structure which can grow freely from here. 

[ RELATION_TY_Create kind_id sb_address from
    short_block long_block i handler;
    long_block = CreatePVLongBlockFlexible(kind_id, RRV_DATA_BASE + 3*RRP_MIN_SIZE);
    if ((from == 0) && (kind_id)) from = DefaultValueFinder(kind_id);
    if (from) {
        for (i=0: i<RRV_DATA_BASE: i++) InitialisePVLongBlockField(long_block, i, PVField(from, i));
        if (PVField(from, RRV_HANDLER) == EmptyRelationHandler) {
            handler = ChooseRelationHandler(PVLongBlockField(long_block, RRV_KIND));
            InitialisePVLongBlockField(long_block, RRV_NAME, "anonymous relation");
            InitialisePVLongBlockField(long_block, RRV_PERMISSIONS,
                RELS_TEST+RELS_ASSERT_TRUE+RELS_ASSERT_FALSE+RELS_SHOW);
            InitialisePVLongBlockField(long_block, RRV_HANDLER, handler);
            InitialisePVLongBlockField(long_block, RRV_STORAGE, RRP_MIN_SIZE-1);
            InitialisePVLongBlockField(long_block, RRV_DESCRIPTION, "an anonymous relation");
            InitialisePVLongBlockField(long_block, RRV_USED, 0);
            InitialisePVLongBlockField(long_block, RRV_FILLED, 0);
        }
    } else {
        handler = ChooseRelationHandler(kind_id);
        InitialisePVLongBlockField(long_block, RRV_NAME, "anonymous relation");
        InitialisePVLongBlockField(long_block, RRV_PERMISSIONS,
            RELS_TEST+RELS_ASSERT_TRUE+RELS_ASSERT_FALSE+RELS_SHOW);
        InitialisePVLongBlockField(long_block, RRV_STORAGE, RRP_MIN_SIZE-1);
        InitialisePVLongBlockField(long_block, RRV_KIND, kind_id);
        InitialisePVLongBlockField(long_block, RRV_HANDLER, handler);
        InitialisePVLongBlockField(long_block, RRV_DESCRIPTION, "an anonymous relation");
        InitialisePVLongBlockField(long_block, RRV_USED, 0);
        InitialisePVLongBlockField(long_block, RRV_FILLED, 0);
    }

    short_block = CreatePVShortBlock(sb_address, kind_id);
    short_block-->0 = long_block;

    return short_block;
];

§7. Extent. We need to provide an explicit function for this, even though we only say the answer is "use the capacity". 

[ RELATION_TY_LongBlockSize rel;
    return 0;
];

§8. Destruction. If the relation stores block values on either side, invoke the handler using a special task value to free the memory associated with them. 

[ RELATION_TY_Destroy rel  handler;
    handler = PVField(rel, RRV_HANDLER);
    handler(rel, RELS_DESTROY);
];

§9. Copying. Same as destruction: invoke the handler using a special value to tell it to perform deep copying. 

[ RELATION_TY_Copy lto lfrom kind recycling  handler;
    CopyPVRawData(lto, lfrom, kind, recycling);
    handler = PVField(lto, RRV_HANDLER);
    handler(lto, RELS_COPY);
];

§10. Comparison. It really isn't clear how to define equality for relations, but we follow the doctrine above. What we don't do is to test its actual state — that would be very slow and might be impossible. 

[ RELATION_TY_Compare rleft rright ind1 ind2;
    ind1 = PVField(rleft, RRV_HANDLER);
    ind2 = PVField(rright, RRV_HANDLER);
    if (ind1 ~= ind2) return ind1 - ind2;
    if (IsMutableRelationHandler(ind1) == false) return 0;
    return rleft - rright;
];

[ RELATION_TY_Distinguish rleft rright;
    if (RELATION_TY_Compare(rleft, rright) == 0) rfalse;
    rtrue;
];

§11. Printing. 

[ RELATION_TY_Say rel;
    if (rel == 0) print "(null relation)"; shouldn't happen
    else print (string) RlnGetF(rel, RR_NAME);
];

§12. Naming. 

[ RELATION_TY_Name rel txt;
    if (rel) {
        WritePVField(rel, RRV_NAME, txt);
        WritePVField(rel, RRV_DESCRIPTION, txt);
    }
];

§13. Choose Relation Handler. We implement two different various-to-various handler routines for the sake of efficiency. The choice of handler routines is made based on the kinds of value being related. Each handler also has a corresponding wrapper for symmetric relations. 

[ ChooseRelationHandler kind_id sym;
    if (KindConformsTo_POINTER_VALUE_TY(KindConstructorTerm(kind_id, 0))) {
        if (sym) return SymHashListRelationHandler;
        return HashListRelationHandler;
    }
    if (sym) return SymDoubleHashSetRelationHandler;
    return DoubleHashSetRelationHandler;
];

[ IsMutableRelationHandler h;
    if (h == SymHashListRelationHandler or HashListRelationHandler or
        SymDoubleHashSetRelationHandler or DoubleHashSetRelationHandler) rtrue;
    rfalse;
];

§14. Valency. "Valency" refers to the number of participants allowed on either side of the relation: various-to-various, one-to-various, various-to-one, or one-to-one. A newly created relation is always various-to-various. We allow the author to change the valency, but only if no entries have been added yet. 

[ RELATION_TY_SetValency rel val  kind_id filled cur handler ext;
    filled = PVField(rel, RRV_FILLED);
    if (filled) { IssueRTP("ChangedImmutableRelation",
        "This change of the relation's nature is impossible in play.",
        BasicInformKitRTPs); rfalse; }
    kind_id = PVField(rel, RRV_KIND);
    if (val == RRVAL_EQUIV or RRVAL_SYM_V_TO_V or RRVAL_SYM_O_TO_O) {
        if (KindConstructorTerm(kind_id, 0) ~= KindConstructorTerm(kind_id, 1)) {
            IssueRTP("ChangedImmutableRelation",
                "This change of the relation's nature is impossible in play.",
                BasicInformKitRTPs); rfalse;
        }
    }
    cur = PVField(rel, RRV_HANDLER);
    switch (val) {
        RRVAL_V_TO_V:       handler = ChooseRelationHandler(kind_id, false);
        RRVAL_V_TO_O:       handler = HashTableRelationHandler;
        RRVAL_O_TO_V:       handler = ReversedHashTableRelationHandler;
        RRVAL_O_TO_O:       handler = TwoInOneHashTableRelationHandler;
        RRVAL_EQUIV:        handler = EquivHashTableRelationHandler;
        RRVAL_SYM_V_TO_V:   handler = ChooseRelationHandler(kind_id, true);
        RRVAL_SYM_O_TO_O:   handler = Sym2in1HashTableRelationHandler;
        default:            IssueRTP("ChangedImmutableRelation",
                                "This change of the relation's nature is impossible in play.",
                                BasicInformKitRTPs); rfalse;
    }
    if (cur == handler) rtrue;
    adjust size when going to or from 2-in-1
    if (cur == TwoInOneHashTableRelationHandler) {
        ext = PVField(rel, RRV_STORAGE) + 1;
        SetPVFieldCapacity(rel, RRV_DATA_BASE + 3*ext);
    } else if (handler == TwoInOneHashTableRelationHandler) {
        ext = PVField(rel, RRV_STORAGE) + 1;
        SetPVFieldCapacity(rel, RRV_DATA_BASE + 4*ext);
    }
    WritePVField(rel, RRV_HANDLER, handler);
];

[ RELATION_TY_GetValency rel  handler;
    return PVField(rel, RRV_PERMISSIONS) & VALENCY_MASK;
];

§15. Double Hash Set Relation Handler. This implements relations which are stored as a double-hashed set. The storage comprises a list of three-word entries \((F, X, Y)\), where \(F\) is a flags word. The ordering of the list is determined by a probe sequence which depends on the combined hash values of \(X\) and \(Y\).

The "storage" word in the header stores one less than the number of entries in the list; the number of entries in the list is always a power of two, so this will always be a bit mask. The "used" and "filled" words store the number of entries which currently hold a value, and the number of entries which have ever held a value (even if it was since deleted), respectively.

The utility routine DoubleHashSetLookUp locates the hash entry for a key/value pair. It returns either the (non-negative) number of the entry where the pair was found, or the (negative) bitwise NOT of the number of the first unused entry where the pair could be inserted. It uses the utility routine DoubleHashSetEntryMatches to compare entries to the sought pair.

The utility routine DoubleHashSetCheckResize checks whether the dictionary has become too full after inserting a pair, and expands it if so. 

[ DoubleHashSetRelationHandler rel task X Y sym  kind_id kx ky at tmp v;
    kind_id = PVField(rel, RRV_KIND);
    kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
    if (task == RELS_SET_VALENCY) {
        return RELATION_TY_SetValency(rel, X);
    } else if (task == RELS_DESTROY) {
        clear
        kx = KindConformsTo_POINTER_VALUE_TY(kx); ky = KindConformsTo_POINTER_VALUE_TY(ky);
        if (~~(kx || ky)) return;
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            tmp = PVField(rel, RRV_DATA_BASE + 3*at);
            if (tmp & RRF_USED) {
                if (kx) DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 1));
                if (ky) DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 2));
            }
            at--;
        }
        return;
    } else if (task == RELS_COPY) {
        X = KindConformsTo_POINTER_VALUE_TY(kx); Y = KindConformsTo_POINTER_VALUE_TY(ky);
        if (~~(X || Y)) return;
        at = PVField(rel, RRV_STORAGE);
        while (at >= 0) {
            tmp = PVField(rel, RRV_DATA_BASE + 3*at);
            if (tmp & RRF_USED) {
                if (X) {
                    tmp = PVField(rel, RRV_DATA_BASE + 3*at + 1);
                    tmp = CopyPV(CreatePV(kx), tmp);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 1, tmp);
                }
                if (Y) {
                    tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);
                    tmp = CopyPV(CreatePV(ky), tmp);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 2, tmp);
                }
            }
            at--;
        }
        return;
    } else if (task == RELS_SHOW) {
        print (string) PVField(rel, RRV_DESCRIPTION), ":^";
        if (sym) {
            kind_id = KindComparisonFunction(kx);
            if (~~kind_id) kind_id = UnsignedCompare;
        }
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            tmp = PVField(rel, RRV_DATA_BASE + 3*at);
            if (tmp & RRF_USED) {
                X = PVField(rel, RRV_DATA_BASE + 3*at + 1);
                Y = PVField(rel, RRV_DATA_BASE + 3*at + 2);
                if (sym && (kind_id(X, Y) > 0)) continue;
                print "  ";
                SayKindValuePair(kx, X);
                if (sym) print " <=> "; else print " >=> ";
                SayKindValuePair(ky, Y);
                print "^";
            }
        }
        return;
    } else if (task == RELS_EMPTY) {
        if (PVField(rel, RRV_USED) == 0) rtrue;
        if (X == 1) {
            DoubleHashSetRelationHandler(rel, RELS_DESTROY);
            for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                tmp = RRV_DATA_BASE + 3*at;
                WritePVField(rel, tmp, 0);
                WritePVField(rel, tmp + 1, 0);
                WritePVField(rel, tmp + 2, 0);
            }
            WritePVField(rel, RRV_USED, 0);
            WritePVField(rel, RRV_FILLED, 0);
            rtrue;
        }
        rfalse;
    } else if (task == RELS_LOOKUP_ANY) {
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            tmp = RRV_DATA_BASE + 3*at;
            if (PVField(rel, tmp) & RRF_USED) {
                if (Y == RLANY_GET_X or RLANY_CAN_GET_X) {
                    v = PVField(rel, tmp + 2);
                    if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                        if (ComparePV(v, X) ~= 0) continue;
                    } else {
                        if (v ~= X) continue;
                    }
                    if (Y == RLANY_CAN_GET_X) rtrue;
                    return PVField(rel, tmp + 1);
                } else {
                    v = PVField(rel, tmp + 1);
                    if (KindConformsTo_POINTER_VALUE_TY(kx)) {
                        if (ComparePV(v, X) ~= 0) continue;
                    } else {
                        if (v ~= X) continue;
                    }
                    if (Y == RLANY_CAN_GET_Y) rtrue;
                    return PVField(rel, tmp + 2);
                }
            }
        }
        if (Y == RLANY_GET_X or RLANY_GET_Y)
            print "*** Lookup failed: value not found ***^";
        rfalse;
    } else if (task == RELS_LOOKUP_ALL_X) {
        if (WeakKindOfPV(Y) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(Y, 0);
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            tmp = RRV_DATA_BASE + 3*at;
            if (PVField(rel, tmp) & RRF_USED) {
                v = PVField(rel, tmp + 2);
                if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                    if (ComparePV(v, X) ~= 0) continue;
                } else {
                    if (v ~= X) continue;
                }
                LIST_OF_TY_InsertItem(Y, PVField(rel, tmp + 1));
            }
        }
        return Y;
    } else if (task == RELS_LOOKUP_ALL_Y) {
        if (WeakKindOfPV(Y) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(Y, 0);
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            tmp = RRV_DATA_BASE + 3*at;
            if (PVField(rel, tmp) & RRF_USED) {
                v = PVField(rel, tmp + 1);
                if (KindConformsTo_POINTER_VALUE_TY(kx)) {
                    if (ComparePV(v, X) ~= 0) continue;
                } else {
                    if (v ~= X) continue;
                }
                LIST_OF_TY_InsertItem(Y, PVField(rel, tmp + 2));
            }
        }
        return Y;
    } else if (task == RELS_LIST) {
        if (X == 0 || WeakKindOfPV(X) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(X, 0);
        switch (Y) {
            RLIST_ALL_X, RLIST_ALL_Y:
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 3*at;
                    if (PVField(rel, tmp) & RRF_USED) {
                        tmp++;
                        if (Y == RLIST_ALL_Y) tmp++;
                        v = PVField(rel, tmp);
                        LIST_OF_TY_InsertItem(X, v, false, 0, true);
                    }
                }
                return X;
            RLIST_ALL_PAIRS:
                LIST_OF_TY_InsertItem will make a deep copy of the item,
                so we can reuse a single combination value here

                Y = CreatePV(kind_id);
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 3*at;
                    if (PVField(rel, tmp) & RRF_USED) {
                        v = PVField(rel, tmp + 1);
                        WritePVField(Y, COMBINATION_ITEM_BASE, v);
                        v = PVField(rel, tmp + 2);
                        WritePVField(Y, COMBINATION_ITEM_BASE + 1, v);
                        LIST_OF_TY_InsertItem(X, Y);
                    }
                }
                WritePVField(Y, COMBINATION_ITEM_BASE, 0);
                WritePVField(Y, COMBINATION_ITEM_BASE + 1, 0);
                DestroyPV(Y);
                return X;
        }
        rfalse;
    }
    at = DoubleHashSetLookUp(rel, kx, ky, X, Y);
    switch(task) {
        RELS_TEST:
            if (at >= 0) rtrue;
            rfalse;
        RELS_ASSERT_TRUE:
            if (at >= 0) rtrue;
            at = ~at;
            WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 1);
            if (PVField(rel, RRV_DATA_BASE + 3*at) == 0)
                WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
            WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
            if (KindConformsTo_POINTER_VALUE_TY(kx)) { X = CopyPV(CreatePV(kx), X); }
            if (KindConformsTo_POINTER_VALUE_TY(ky)) { Y = CopyPV(CreatePV(ky), Y); }
            WritePVField(rel, RRV_DATA_BASE + 3*at + 1, X);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 2, Y);
            DoubleHashSetCheckResize(rel);
            rtrue;
        RELS_ASSERT_FALSE:
            if (at < 0) rtrue;
            WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) - 1);
            if (KindConformsTo_POINTER_VALUE_TY(kx))
                DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 1));
            if (KindConformsTo_POINTER_VALUE_TY(ky))
                DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 2));
            WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_DELETED);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 1, 0);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 2, 0);
            rtrue;
    }
];

[ DoubleHashSetLookUp rel kx ky X Y  hashv i free mask perturb flags;
    calculate a hash value for the pair
    hashv = HashKindValuePair(kx, X) + HashKindValuePair(ky, Y);
    look in the first expected slot
    mask = PVField(rel, RRV_STORAGE);
    i = hashv & mask;
    flags = PVField(rel, RRV_DATA_BASE + 3*i);
    if (flags == 0) return ~i;
    if (DoubleHashSetEntryMatches(rel, i, kx, ky, X, Y)) return i;
    not here, keep looking in sequence
    free = -1;
    if (flags & RRF_DELETED) free = i;
    perturb = hashv;
    hashv = i;
    for (::) {
        hashv = hashv*5 + perturb + 1;
        i = hashv & mask;
        flags = PVField(rel, RRV_DATA_BASE + 3*i);
        if (flags == 0) {
            if (free >= 0) return ~free;
            return ~i;
        }
        if (DoubleHashSetEntryMatches(rel, i, kx, ky, X, Y))
            return i;
        if ((free < 0) && (flags & RRF_DELETED)) free = i;
        #ifdef TARGET_ZCODE;
        @log_shift perturb MINUS_RRP_PERTURB_SHIFT -> perturb;
        #ifnot;
        @ushiftr perturb RRP_PERTURB_SHIFT perturb;
        #endif;
    }
];

[ DoubleHashSetCheckResize rel  filled ext newext temp i at kind_id kx ky F X Y;
    filled = PVField(rel, RRV_FILLED);
    ext = PVField(rel, RRV_STORAGE) + 1;
    if (filled >= (ext - filled) * RRP_CROWDED_IS) {
        copy entries to temporary space
        temp = FlexAllocate(ext * (3*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
        for (i=0: i<ext*3: i++)
            InitialisePVLongBlockField(temp, i, PVField(rel, RRV_DATA_BASE+i));
        resize and clear our data
        if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE;
        else newext = ext * RRP_RESIZE_SMALL;
        SetPVFieldCapacity(rel, RRV_DATA_BASE + newext*3);
        WritePVField(rel, RRV_STORAGE, newext - 1);
        WritePVField(rel, RRV_FILLED, PVField(rel, RRV_USED));
        for (i=0: i<newext*3: i++)
            WritePVField(rel, RRV_DATA_BASE+i, 0);
        copy entries back from temporary space
        kind_id = PVField(rel, RRV_KIND);
        kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
        for (i=0: i<ext: i++) {
            F = PVLongBlockField(temp, 3*i);
            if (F == 0 || (F & RRF_DELETED)) continue;
            X = PVLongBlockField(temp, 3*i + 1);
            Y = PVLongBlockField(temp, 3*i + 2);
            at = DoubleHashSetLookUp(rel, kx, ky, X, Y);
            if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; }
            at = ~at;
            WritePVField(rel, RRV_DATA_BASE + 3*at, F);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 1, X);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 2, Y);
        }
        done with temporary space
        FlexFree(temp);
    }
];

[ DoubleHashSetEntryMatches rel at kx ky X Y  cx cy;
    cx = PVField(rel, RRV_DATA_BASE + 3*at + 1);
    if (KindConformsTo_POINTER_VALUE_TY(kx)) {
        if (ComparePV(cx, X) ~= 0) rfalse;
    } else {
        if (cx ~= X) rfalse;
    }
    cy = PVField(rel, RRV_DATA_BASE + 3*at + 2);
    if (KindConformsTo_POINTER_VALUE_TY(ky)) {
        if (ComparePV(cy, Y) ~= 0) rfalse;
    } else {
        if (cy ~= Y) rfalse;
    }
    rtrue;
];

§16. Hash List Relation Handler. This implements relations which are stored as a hash table mapping keys to either single values or lists of values. The storage comprises a list of three-word entries, either \((F, X, Y)\) or \((F, X, L)\), where \(F\) is a flags word distinguishing between the two cases (among other things). In the latter case, \(L\) is a pointer to a list (LIST_OF_TY) containing the values.

The "storage", "used", and "filled" words have the same meanings as above.

HashListRelationHandler is a thin wrapper around HashCoreRelationHandler, which is shared with two other handlers below. 

[ HashListRelationHandler rel task X Y  sym kind_id kx ky;
    kind_id = PVField(rel, RRV_KIND);
    kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
    return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 1);
];

§17. Hash Table Relation Handler. This is the same as the Hash List Relation Handler above, except that only one value may be stored for each key. This implements various-to-one relations. 

[ HashTableRelationHandler rel task X Y  kind_id kx ky;
    kind_id = PVField(rel, RRV_KIND);
    kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
    return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 0);
];

§18. Reversed Hash Table Relation Handler. This is the same as the Hash Table Relation Handler except that the sides are reversed. This implements one-to-various relations. 

[ ReversedHashTableRelationHandler rel task X Y  kind_id kx ky swap;
print "ReversedHashTableRelationHandler ", rel, " ", task, " X=", X, " Y=", Y, "^";
    kind_id = PVField(rel, RRV_KIND);
    kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
    switch (task) {
        RELS_SET_VALENCY:
            return RELATION_TY_SetValency(rel, X);
        RELS_TEST, RELS_ASSERT_TRUE, RELS_ASSERT_FALSE:
            return HashCoreRelationHandler(rel, task, ky, kx, Y, X, 0);
        RELS_LOOKUP_ANY:
            switch (Y) {
                RLANY_GET_X: Y = RLANY_GET_Y;
                RLANY_GET_Y: Y = RLANY_GET_X;
                RLANY_CAN_GET_X: Y = RLANY_CAN_GET_Y; swap=kx; kx=ky; ky=swap;
                RLANY_CAN_GET_Y: Y = RLANY_CAN_GET_X; swap=kx; kx=ky; ky=swap;
            }
        RELS_LOOKUP_ALL_X:
            task = RELS_LOOKUP_ALL_Y;
        RELS_LOOKUP_ALL_Y:
            task = RELS_LOOKUP_ALL_X;
        RELS_SHOW:
            swap=X; X=Y; Y=swap;
            swap=kx; kx=ky; ky=swap;
        RELS_LIST:
            switch (Y) {
                RLIST_ALL_X: Y = RLIST_ALL_Y;
                RLIST_ALL_Y: Y = RLIST_ALL_X;
            }
    }
    return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 0);
];

§19. Symmetric Relation Handlers. These are simple wrappers around the asymmetric handlers defined above. When a pair is inserted or removed, the wrappers insert or remove the reversed pair as well.

SymDoubleHashSetRelationHandler and SymHashListRelationHandler implement symmetric V-to-V relations. Sym2in1HashTableRelationHandler implements symmetric 1-to-1. ("SymTwoInOneHashTableRelationHandler" would have exceeded Inform 6's 32-character name limit.) 

[ SymDoubleHashSetRelationHandler rel task X Y;
    if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE)
        DoubleHashSetRelationHandler(rel, task, Y, X);
    return DoubleHashSetRelationHandler(rel, task, X, Y, 1);
];

[ SymHashListRelationHandler rel task X Y;
    if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE)
        HashListRelationHandler(rel, task, Y, X);
    return HashListRelationHandler(rel, task, X, Y);
];

[ Sym2in1HashTableRelationHandler rel task X Y;
    if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE)
        TwoInOneHashTableRelationHandler(rel, task, Y, X);
    return TwoInOneHashTableRelationHandler(rel, task, X, Y, 1);
];

§20. Hash Core Relation Handler. This implements the core functionality that is shared between HashListRelationHandler, HashTableRelationHandler, and ReversedHashTableRelationHandler. All three handlers are the same except for whether the left or right side is the "key" and whether or not multiple values may be stored for a single key.

As noted above, the table contains three-word entries, \((F, X, Y)\), where \(F\) is a flags word. Only the hash code of \(X\) is used. If \(F\) includes RRF_SINGLE, \(Y\) is a single value; otherwise, \(Y\) is a list (LIST_OF_TY) of values. If mult is zero, RRF_SINGLE must always be set, allowing only one value per key: a new pair \((X, Y')\) will replace the existing pair \((X, Y)\). 

[ HashCoreRelationHandler rel task kx ky X Y mult  sym rev at tmp fl;
    if (task == RELS_SET_VALENCY) {
        return RELATION_TY_SetValency(rel, X);
    } else if (task == RELS_DESTROY) {
        clear
        kx = KindConformsTo_POINTER_VALUE_TY(kx); ky = KindConformsTo_POINTER_VALUE_TY(ky);
        if (~~(kx || ky)) return;
        at = PVField(rel, RRV_STORAGE);
        while (at >= 0) {
            fl = PVField(rel, RRV_DATA_BASE + 3*at);
            if (fl & RRF_USED) {
                if (kx) DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 1));
                if (ky || ~~(fl & RRF_SINGLE))
                    DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 2));
            }
            at--;
        }
        return;
    } else if (task == RELS_COPY) {
        X = KindConformsTo_POINTER_VALUE_TY(kx); Y = KindConformsTo_POINTER_VALUE_TY(ky);
        if (~~(X || Y)) return;
        at = PVField(rel, RRV_STORAGE);
        while (at >= 0) {
            fl = PVField(rel, RRV_DATA_BASE + 3*at);
            if (fl & RRF_USED) {
                if (X) {
                    tmp = PVField(rel, RRV_DATA_BASE + 3*at + 1);
                    tmp = CopyPV(CreatePV(kx), tmp);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 1, tmp);
                }
                if (Y || ~~(fl & RRF_SINGLE)) {
                    tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);
                    tmp = CopyPV(CreatePV(WeakKindOfPV(tmp)), tmp);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 2, tmp);
                }
            }
            at--;
        }
        return;
    } else if (task == RELS_SHOW) {
        print (string) PVField(rel, RRV_DESCRIPTION), ":^";
        Z-machine doesn't have the room to let us pass sym/rev as parameters
        switch (RELATION_TY_GetValency(rel)) {
            RRVAL_SYM_V_TO_V:
                sym = 1;
                tmp = KindComparisonFunction(kx);
                if (~~tmp) tmp = UnsignedCompare;
            RRVAL_O_TO_V:
                rev = 1;
        }
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            fl = PVField(rel, RRV_DATA_BASE + 3*at);
            if (fl & RRF_USED) {
                X = PVField(rel, RRV_DATA_BASE + 3*at + 1);
                Y = PVField(rel, RRV_DATA_BASE + 3*at + 2);
                if (fl & RRF_SINGLE) {
                    if (sym && tmp(X, Y) > 0) continue;
                    print "  ";
                    if (rev) SayKindValuePair(ky, Y);
                    else SayKindValuePair(kx, X);
                    if (sym) print " <=> "; else print " >=> ";
                    if (rev) SayKindValuePair(kx, X);
                    else SayKindValuePair(ky, Y);
                    print "^";
                } else {
                    for (mult=1: mult<=LIST_OF_TY_GetLength(Y): mult++) {
                        fl = LIST_OF_TY_GetItem(Y, mult);
                        if (sym && tmp(X, fl) > 0) continue;
                        print "  ";
                        if (rev) SayKindValuePair(ky, fl);
                        else SayKindValuePair(kx, X);
                        if (sym) print " <=> "; else print " >=> ";
                        if (rev) SayKindValuePair(kx, X);
                        else SayKindValuePair(ky, fl);
                        print "^";
                    }
                }
            }
        }
        return;
    } else if (task == RELS_EMPTY) {
        if (PVField(rel, RRV_USED) == 0) rtrue;
        if (X == 1) {
            HashCoreRelationHandler(rel, RELS_DESTROY);
            for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                tmp = RRV_DATA_BASE + 3*at;
                WritePVField(rel, tmp, 0);
                WritePVField(rel, tmp + 1, 0);
                WritePVField(rel, tmp + 2, 0);
            }
            WritePVField(rel, RRV_USED, 0);
            WritePVField(rel, RRV_FILLED, 0);
            rtrue;
        }
        rfalse;
    } else if (task == RELS_LOOKUP_ANY) {
        if (Y == RLANY_GET_Y or RLANY_CAN_GET_Y) {
            at = HashCoreLookUp(rel, kx, X);
            if (at >= 0) {
                if (Y == RLANY_CAN_GET_Y) rtrue;
                tmp = RRV_DATA_BASE + 3*at;
                fl = PVField(rel, tmp);
                tmp = PVField(rel, tmp + 2);
                if (fl & RRF_SINGLE) return tmp;
                return LIST_OF_TY_GetItem(tmp, 1);
            }
        } else {
            for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                tmp = RRV_DATA_BASE + 3*at;
                fl = PVField(rel, tmp);
                if (fl & RRF_USED) {
                    sym = PVField(rel, tmp + 2);
                    if (fl & RRF_SINGLE) {
                        if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                            if (ComparePV(X, sym) ~= 0) continue;
                        } else {
                            if (X ~= sym) continue;
                        }
                    } else {
                        if (LIST_OF_TY_FindItem(sym, X) == 0) continue;
                    }
                    if (Y == RLANY_CAN_GET_X) rtrue;
                    return PVField(rel, tmp + 1);
                }
            }
        }
        if (Y == RLANY_GET_X or RLANY_GET_Y)
            print "*** Lookup failed: value not found ***^";
        rfalse;
    } else if (task == RELS_LOOKUP_ALL_X) {
        if (WeakKindOfPV(Y) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(Y, 0);
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            tmp = RRV_DATA_BASE + 3*at;
            fl = PVField(rel, tmp);
            if (fl & RRF_USED) {
                sym = PVField(rel, tmp + 2);
                if (fl & RRF_SINGLE) {
                    if (KindConformsTo_POINTER_VALUE_TY(kx)) {
                        if (ComparePV(X, sym) ~= 0) continue;
                    } else {
                        if (X ~= sym) continue;
                    }
                } else {
                    if (LIST_OF_TY_FindItem(sym, X) == 0) continue;
                }
                LIST_OF_TY_InsertItem(Y, PVField(rel, tmp + 1));
            }
        }
        return Y;
    } else if (task == RELS_LOOKUP_ALL_Y) {
        if (WeakKindOfPV(Y) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(Y, 0);
        at = HashCoreLookUp(rel, kx, X);
        if (at >= 0) {
            tmp = RRV_DATA_BASE + 3*at;
            fl = PVField(rel, tmp);
            tmp = PVField(rel, tmp + 2);
            if (fl & RRF_SINGLE)
                LIST_OF_TY_InsertItem(Y, tmp);
            else
                LIST_OF_TY_AppendList(Y, tmp);
        }
        return Y;
    } else if (task == RELS_LIST) {
        if (WeakKindOfPV(X) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(X, 0);
        switch (Y) {
            RLIST_ALL_X:
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 3*at;
                    fl = PVField(rel, tmp);
                    if (fl & RRF_USED)
                        LIST_OF_TY_InsertItem(X, PVField(rel, tmp + 1));
                }
                return X;
            RLIST_ALL_Y:
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 3*at;
                    fl = PVField(rel, tmp);
                    if (fl & RRF_USED) {
                        tmp = PVField(rel, tmp + 2);
                        if (fl & RRF_SINGLE)
                            LIST_OF_TY_InsertItem(X, tmp, false, 0, true);
                        else
                            LIST_OF_TY_AppendList(X, tmp, false, 0, true);
                    }
                }
                return X;
            RLIST_ALL_PAIRS:
                if (RELATION_TY_GetValency(rel) == RRVAL_O_TO_V) rev = 1;
                LIST_OF_TY_InsertItem will make a deep copy of the item,
                so we can reuse a single combination value here
                Y = CreatePV(COMBINATION_TY, tmp);
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 3*at;
                    fl = PVField(rel, tmp);
                    if (fl & RRF_USED) {
                        WritePVField(Y, COMBINATION_ITEM_BASE + rev, PVField(rel, tmp + 1));
                        tmp = PVField(rel, tmp + 2);
                        if (fl & RRF_SINGLE) {
                            WritePVField(Y, COMBINATION_ITEM_BASE + 1 - rev, tmp);
                            LIST_OF_TY_InsertItem(X, Y);
                        } else {
                            for (mult = LIST_OF_TY_GetLength(tmp): mult > 0: mult--) {
                                WritePVField(Y, COMBINATION_ITEM_BASE + 1 - rev,
                                    LIST_OF_TY_GetItem(tmp, mult));
                                LIST_OF_TY_InsertItem(X, Y);
                            }
                        }
                    }
                }
                WritePVField(Y, COMBINATION_ITEM_BASE, 0);
                WritePVField(Y, COMBINATION_ITEM_BASE + 1, 0);
                DestroyPV(Y);
                return X;
        }
        rfalse;
    }
    at = HashCoreLookUp(rel, kx, X);
    switch(task) {
        RELS_TEST:
            if (at < 0) rfalse;
            fl = PVField(rel, RRV_DATA_BASE + 3*at);
            tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);
            if (fl & RRF_SINGLE) {
                if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                    if (ComparePV(tmp, Y) == 0) rtrue;
                } else {
                    if (tmp == Y) rtrue;
                }
                rfalse;
            } else {
                return LIST_OF_TY_FindItem(tmp, Y);
            }
        RELS_ASSERT_TRUE:
            if (at < 0) {
                no entry exists for this key, just add one
                at = ~at;
                WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 1);
                if (PVField(rel, RRV_DATA_BASE + 3*at) == 0)
                    WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
                WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
                if (KindConformsTo_POINTER_VALUE_TY(kx)) { X = CopyPV(CreatePV(kx), X); }
                if (KindConformsTo_POINTER_VALUE_TY(ky)) { Y = CopyPV(CreatePV(ky), Y); }
                WritePVField(rel, RRV_DATA_BASE + 3*at + 1, X);
                WritePVField(rel, RRV_DATA_BASE + 3*at + 2, Y);
                HashCoreCheckResize(rel);
                break;
            }
            an entry exists: could be a list or a single value
            fl = PVField(rel, RRV_DATA_BASE + 3*at);        flags
            tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);   value or list
            if (fl & RRF_SINGLE) {
                if Y is the same as the stored key, we have nothing to do
                if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                    if (ComparePV(tmp, Y) == 0) rtrue;
                } else {
                    if (tmp == Y) rtrue;
                }
                it's different: either replace it or expand into a list,
                depending on the value of mult
                if (mult) {
                    fl = CreatePV(LIST_OF_TY);  new list
                    WritePVField(fl, LIST_ITEM_KOV_F, ky);
                    LIST_OF_TY_SetLength(fl, 2);
                    WritePVField(fl, LIST_ITEM_BASE, tmp);  do not copy
                    LIST_OF_TY_PutItem(fl, 2, Y);       copy if needed
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 2, fl);
                    WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_USED);
                } else {
                    if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                        DestroyPV(tmp);
                        Y = CopyPV(CreatePV(ky), Y);
                    }
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 2, Y);
                }
            } else {
                if Y is present already, do nothing. otherwise add it.
                LIST_OF_TY_InsertItem(tmp, Y, 0, 0, 1);
            }
            rtrue;
        RELS_ASSERT_FALSE:
            if (at < 0) rtrue;
            an entry exists: could be a list or a single value
            fl = PVField(rel, RRV_DATA_BASE + 3*at);        flags
            tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);   value or list
            if (fl & RRF_SINGLE) {
                if the stored key isn't Y, we have nothing to do
                if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                    if (ComparePV(tmp, Y) ~= 0) rtrue;
                } else {
                    if (tmp ~= Y) rtrue;
                }
                delete the entry
                if (KindConformsTo_POINTER_VALUE_TY(ky))
                    DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 2));
                .DeleteEntryIgnoringY;
                WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) - 1);
                if (KindConformsTo_POINTER_VALUE_TY(kx))
                    DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 1));
                WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_DELETED);
                WritePVField(rel, RRV_DATA_BASE + 3*at + 1, 0);
                WritePVField(rel, RRV_DATA_BASE + 3*at + 2, 0);
            } else {
                remove Y from the list if present
                LIST_OF_TY_RemoveValue(tmp, Y, 1);
                if the list is now empty, delete the whole entry
                if (LIST_OF_TY_GetLength(tmp) == 0) {
                    DestroyPV(tmp);
                    jump DeleteEntryIgnoringY;
                }
            }
            rtrue;
    }
    rtrue;
];

[ HashCoreLookUp rel kx X  hashv i free mask perturb flags;
    calculate a hash value for the key
    hashv = HashKindValuePair(kx, X);
    look in the first expected slot
    mask = PVField(rel, RRV_STORAGE);
    i = hashv & mask;
    flags = PVField(rel, RRV_DATA_BASE + 3*i);
    if (flags == 0) {
        return ~i;
    }
    if (HashCoreEntryMatches(rel, i, kx, X)) {
        return i;
    }
    not here, keep looking in sequence
    free = -1;
    if (flags & RRF_DELETED) free = i;
    perturb = hashv;
    hashv = i;
    for (::) {
        hashv = hashv*5 + perturb + 1;
        i = hashv & mask;
        flags = PVField(rel, RRV_DATA_BASE + 3*i);
        if (flags == 0) {
            if (free >= 0) return ~free;
            return ~i;
        }
        if (HashCoreEntryMatches(rel, i, kx, X)) {
            return i;
        }
        if ((free < 0) && (flags & RRF_DELETED)) free = i;
        #ifdef TARGET_ZCODE;
        @log_shift perturb MINUS_RRP_PERTURB_SHIFT -> perturb;
        #ifnot;
        @ushiftr perturb RRP_PERTURB_SHIFT perturb;
        #endif;
    }
];

[ HashCoreCheckResize rel  filled ext newext temp i at kind_id kx F X Y;
    filled = PVField(rel, RRV_FILLED);
    ext = PVField(rel, RRV_STORAGE) + 1;
    if (filled >= (ext - filled) * RRP_CROWDED_IS) {
        copy entries to temporary space
        temp = FlexAllocate(ext * (3*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
        for (i=0: i<ext*3: i++)
            InitialisePVLongBlockField(temp, i, PVField(rel, RRV_DATA_BASE+i));
        resize and clear our data
        if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE;
        else newext = ext * RRP_RESIZE_SMALL;
        SetPVFieldCapacity(rel, RRV_DATA_BASE + newext*3);
        WritePVField(rel, RRV_STORAGE, newext - 1);
        WritePVField(rel, RRV_FILLED, PVField(rel, RRV_USED));
        for (i=0: i<newext*3: i++)
            WritePVField(rel, RRV_DATA_BASE+i, 0);
        copy entries back from temporary space
        kind_id = PVField(rel, RRV_KIND);
        kx = KindConstructorTerm(kind_id, 1); Was 0
        for (i=0: i<ext: i++) {
            F = PVLongBlockField(temp, 3*i);
            if (F == 0 || (F & RRF_DELETED)) continue;
            X = PVLongBlockField(temp, 3*i + 1);
            Y = PVLongBlockField(temp, 3*i + 2);
            at = HashCoreLookUp(rel, kx, X);
            if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; }
            at = ~at;
            WritePVField(rel, RRV_DATA_BASE + 3*at, F);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 1, X);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 2, Y);
        }
        done with temporary space
        FlexFree(temp);
    }
];

[ HashCoreEntryMatches rel at kx X  cx cy;
    cx = PVField(rel, RRV_DATA_BASE + 3*at + 1);
    if (KindConformsTo_POINTER_VALUE_TY(kx)) {
        if (ComparePV(cx, X) ~= 0) rfalse;
    } else {
        if (cx ~= X) rfalse;
    }
    rtrue;
];

§21. Equivalence Hash Table Relation Handler. This implements group relations. The table format is identical to that used by HashCoreRelationHandler, but we use it differently. Although the relation appears to relate Xs to Xs as far as the game is concerned, the table actually relates Xs to numbers, where each number identifies a group of related items. Any X not listed in the table is implicitly in a single-member group.

When a pair \((X, Y)\) is inserted, one of four cases occurs:

1. Neither \(X\) nor \(Y\) has a table entry. We search the table to find the next unused group number, then add both \(X\) and \(Y\) to that group.

2. Both \(X\) and \(Y\) have existing table entries. If the group numbers differ, we walk through the table and change all occurrences of the higher number to the lower one.

3. \(X\) has an existing table entry but \(Y\) does not. We add a \(Y\) entry using the group number of \(X\).

4. \(Y\) has an existing table entry but \(X\) does not. We add an \(X\) entry using the group number of \(Y\).

When a pair \((X, Y)\) is removed, we first verify that \(X\) and \(Y\) are in the same group, then delete the table entry for \(X\). This may leave \(Y\) in a single-member group, which could be deleted, but detecting that situation would be inefficient, so we keep the \(Y\) entry regardless.

This code uses the Hash Core utility functions defined above. 

[ EquivHashTableRelationHandler rel task X Y  kx at at2 tmp fl i ext;
    kx = KindConstructorTerm(PVField(rel, RRV_KIND), 0);
    if (task == RELS_SET_VALENCY) {
        return RELATION_TY_SetValency(rel, X);
    } else if (task == RELS_DESTROY) {
        clear
        if (KindConformsTo_POINTER_VALUE_TY(kx)) {
            at = PVField(rel, RRV_STORAGE);
            while (at >= 0) {
                fl = PVField(rel, RRV_DATA_BASE + 3*at);
                if (fl & RRF_USED) {
                    DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 1));
                }
                at--;
            }
        }
        return;
    } else if (task == RELS_COPY) {
        if (KindConformsTo_POINTER_VALUE_TY(kx)) {
            at = PVField(rel, RRV_STORAGE);
            while (at >= 0) {
                fl = PVField(rel, RRV_DATA_BASE + 3*at);
                if (fl & RRF_USED) {
                    tmp = PVField(rel, RRV_DATA_BASE + 3*at + 1);
                    tmp = CopyPV(CreatePV(kx), tmp);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 1);
                }
                at--;
            }
        }
        return;
    } else if (task == RELS_SHOW) {
        print (string) PVField(rel, RRV_DESCRIPTION), ":^";
        ext = PVField(rel, RRV_STORAGE);
        flag all items by negating their group numbers
        for (at=0, X=RRV_DATA_BASE: at<=ext: at++, X=X+3)
            if (PVField(rel, X) & RRF_USED)
                WritePVField(rel, X + 2, -(PVField(rel, X + 2)));
        display groups, unflagging them as we go
        for (at=0, X=RRV_DATA_BASE, fl=0: at<=ext: at++, X=X+3, fl=0) {
            if (PVField(rel, X) & RRF_USED) {
                fl = PVField(rel, X + 2);
                if (fl > 0) continue;       already visited
                WritePVField(rel, X + 2, -fl);  unflag it
                display the group starting with this member, but only
                if there are more members in the group
                tmp = PVField(rel, X + 1);
                i = 0;
                for (at2=at+1, Y=RRV_DATA_BASE+3*at2: at2<=ext: at2++, Y=Y+3) {
                    if (PVField(rel, Y) & RRF_USED) {
                        if (PVField(rel, Y + 2) ~= fl) continue;
                        WritePVField(rel, Y + 2, -fl);
                        if (~~i) {
                            print the saved first member
                            print "  { ";
                            SayKindValuePair(kx, tmp);
                            i = 1;
                        }
                        print ", ";
                        SayKindValuePair(kx, PVField(rel, Y + 1));
                    }
                }
                if (i) print " }^";
            }
        }
        return;
    } else if (task == RELS_EMPTY) {
        never empty since R(x,x) is always true
        rfalse;
    } else if (task == RELS_LOOKUP_ANY) {
        kind of a cheat, but it's faster than searching for a better value to return
        if (Y == RLANY_CAN_GET_X or RLANY_CAN_GET_Y) rtrue;
        return X;
    } else if (task == RELS_LOOKUP_ALL_X or RELS_LOOKUP_ALL_Y) {
        if (WeakKindOfPV(Y) ~= LIST_OF_TY) rfalse;
        LIST_OF_TY_SetLength(Y, 0);
        WritePVField(Y, LIST_ITEM_KOV_F, kx);
        at = HashCoreLookUp(rel, kx, X);
        if (at < 0) {
            LIST_OF_TY_InsertItem(Y, X);
        } else {
            X = PVField(rel, RRV_DATA_BASE + 3*at + 2);
            for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                tmp = RRV_DATA_BASE + 3*at;
                fl = PVField(rel, tmp);
                if (fl & RRF_USED) {
                    if (PVField(rel, tmp + 2) ~= X) continue;
                    LIST_OF_TY_InsertItem(Y, PVField(rel, tmp + 1));
                }
            }
        }
        return Y;
    } else if (task == RELS_LIST) {
        print "*** Domains of equivalence relations cannot be listed ***^";
        return X;
    }
    at = HashCoreLookUp(rel, kx, X);
    at2 = HashCoreLookUp(rel, kx, Y);
    switch(task) {
        RELS_TEST:
            if (at < 0) {
                X is a loner, but could still be true if X == Y
                if (KindConformsTo_POINTER_VALUE_TY(kx)) {
                    if (ComparePV(X, Y) == 0) rtrue;
                } else {
                    if (X == Y) rtrue;
                }
                rfalse;
            }
            if (at2 < 0) rfalse;
            if (at == at2) rtrue;
            tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);
            if (PVField(rel, RRV_DATA_BASE + 3*at2 + 2) == tmp) rtrue;
            rfalse;
        RELS_ASSERT_TRUE:
            if X and Y are the same, we have nothing to do
            if (KindConformsTo_POINTER_VALUE_TY(kx)) {
                if (ComparePV(X, Y) == 0) rtrue;
            } else {
                if (X == Y) rtrue;
            }
            if (at < 0) {
                if (at2 < 0) {
                    X and Y both missing: find a new group number and add both entries
                    tmp = 0;        candidate group number
                    ext = PVField(rel, RRV_STORAGE);
                    for (i=0: i<=ext: i++) {
                        fl = PVField(rel, RRV_DATA_BASE + 3*i);
                        if (fl & RRF_USED) {
                            fl = PVField(rel, RRV_DATA_BASE + 3*i + 2);
                            if (fl > tmp) tmp = fl;
                        }
                    }
                    tmp++;          new group number
                    WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 2);
                    add X entry
                    at = ~at;
                    if (KindConformsTo_POINTER_VALUE_TY(kx)) { X = CopyPV(CreatePV(kx), X); }
                    fl = PVField(rel, RRV_DATA_BASE + 3*at);
                    if (fl == 0)
                        WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
                    WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 1, X);
                    WritePVField(rel, RRV_DATA_BASE + 3*at + 2, tmp);
                    add Y entry. at2 might change if X and Y have the same hash code.
                    at2 = ~(HashCoreLookUp(rel, kx, Y));
                    if (KindConformsTo_POINTER_VALUE_TY(kx)) { Y = CopyPV(CreatePV(kx), Y); }
                    fl = PVField(rel, RRV_DATA_BASE + 3*at2);
                    if (fl == 0)
                        WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
                    WritePVField(rel, RRV_DATA_BASE + 3*at2, RRF_USED+RRF_SINGLE);
                    WritePVField(rel, RRV_DATA_BASE + 3*at2 + 1, Y);
                    WritePVField(rel, RRV_DATA_BASE + 3*at2 + 2, tmp);
                    jump CheckResize;
                }
                X missing, Y present: add a new X entry
                at = ~at;
                if (KindConformsTo_POINTER_VALUE_TY(kx)) { X = CopyPV(CreatePV(kx), X); }
                WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 1);
                fl = PVField(rel, RRV_DATA_BASE + 3*at);
                if (fl == 0)
                    WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
                WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
                WritePVField(rel, RRV_DATA_BASE + 3*at + 1, X);
                tmp = PVField(rel, RRV_DATA_BASE + 3*at2 + 2);
                WritePVField(rel, RRV_DATA_BASE + 3*at + 2, tmp);
                jump CheckResize;
            }
            if (at2 < 0) {
                X present, Y missing: add a new Y entry
                at2 = ~at2;
                if (KindConformsTo_POINTER_VALUE_TY(kx)) { Y = CopyPV(CreatePV(kx), Y); }
                WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 1);
                fl = PVField(rel, RRV_DATA_BASE + 3*at2);
                if (fl == 0)
                    WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
                WritePVField(rel, RRV_DATA_BASE + 3*at2, RRF_USED+RRF_SINGLE);
                WritePVField(rel, RRV_DATA_BASE + 3*at2 + 1, Y);
                tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);
                WritePVField(rel, RRV_DATA_BASE + 3*at2 + 2, tmp);
                jump CheckResize;
            }
            X and Y both present: merge higher group into lower group
            tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);   higher group
            fl = PVField(rel, RRV_DATA_BASE + 3*at2 + 2);   lower group
            if (tmp < fl) { i = tmp; tmp = fl; fl = i; }
            ext = PVField(rel, RRV_STORAGE);
            for (at=0: at<=ext: at++) {
                i = RRV_DATA_BASE + 3*at + 2;
                if (PVField(rel, i) == tmp)
                    WritePVField(rel, i, fl);
            }
            .CheckResize;
            HashCoreCheckResize(rel);
            rtrue;
        RELS_ASSERT_FALSE:
            if X and Y are already in different groups, we have nothing to do
            if (at < 0 || at2 < 0) rtrue;
            tmp = PVField(rel, RRV_DATA_BASE + 3*at + 2);
            if (PVField(rel, RRV_DATA_BASE + 3*at2 + 2) ~= tmp) rtrue;
            delete the entry for X
            WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) - 1);
            if (KindConformsTo_POINTER_VALUE_TY(kx))
                DestroyPV(PVField(rel, RRV_DATA_BASE + 3*at + 1));
            WritePVField(rel, RRV_DATA_BASE + 3*at, RRF_DELETED);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 1, 0);
            WritePVField(rel, RRV_DATA_BASE + 3*at + 2, 0);
            rtrue;
    }
];

§22. Two-In-One Hash Table Relation Handler. This implements one-to-one relations, which are stored as a hash table mapping keys to single values and vice versa. To enforce the one-to-one constraint, we need the ability to quickly check whether a value is present. This could be done with two separate hash tables, one mapping X to Y and one the opposite, but in the interest of conserving memory, we use a single table for both.

Each four-word entry \((F, E, K, V)\) consists of a flags word \(F\), an entry key \(E\) (which may be a "key" or "value" in the hash table sense), a corresponding key \(K\) (when \(E\) is used as a value), and a corresponding value \(V\) (when \(E\) is used as a key). The pair of related values \((X, Y)\) is represented as two table entries: \((F, X, _, Y)\) and \((F, Y, X, _)\).

To conserve memory when block values are used, we only create one copy of \(X\) and/or \(Y\) to share between both entries. When adding a key or value which already exists on either side of the relation, the previous copy will be used. Copies are freed when they are no longer used as entry keys.

Each entry's flags word \(F\) indicates, in addition to the standard flags RRF_USED and RRF_DELETED, also whether the entry contains a corresponding key \(K\) and/or value \(V\) (RRF_HASX, RRF_HASY) and whether the entry's key is the same kind of value as \(X\) or \(Y\) (RRF_ENTKEYX, RRF_ENTKEYY). If both sides of the relation use the same kind of value, or if both sides are word values, both RRF_ENTKEYX and RRF_ENTKEYY will be set on every used entry.

Of particular note for this handler is the utility function TwoInOneDelete, which clears one half of an entry (given its entry key), and optionally clears the corresponding other half stored in a different entry. That is, given the entries \((F, X, _, Y)\) at index i and \((F, Y, X, _)\) elsewhere, TwoInOneDelete(rel, i, kx, ky, RRF_ENTKEYX, 1) will clear both entries and mark them as deleted. If, however, those entries overlap with other pairs — say they're \((F, X, A, Y)\) and \((F, Y, X, B)\) — then the same call to TwoInOneDelete will leave us with \((F, X, A, _)\) and \((F, Y, _, B)\), having cleared the parts corresponding to the pair \((X, Y)\) but not the parts corresponding to the pairs \((A, X)\) and \((Y, B)\), and will not mark either as deleted. (Such overlap is only possible when the domains of \(X\) and \(Y\) are the same kind of value.) 

[ TwoInOneHashTableRelationHandler rel task X Y sym  kind_id kx ky at at2 tmp fl;
    kind_id = PVField(rel, RRV_KIND);
    kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
    if (task == RELS_SET_VALENCY) {
        return RELATION_TY_SetValency(rel, X);
    } else if (task == RELS_DESTROY) {
        clear
        kx = KindConformsTo_POINTER_VALUE_TY(kx); ky = KindConformsTo_POINTER_VALUE_TY(ky);
        if (~~(kx || ky)) return;
        at = PVField(rel, RRV_STORAGE);
        while (at >= 0) {
            fl = PVField(rel, RRV_DATA_BASE + 4*at);
            if (fl & RRF_USED)
                if ((kx && (fl & RRF_ENTKEYX)) || (ky && (fl & RRF_ENTKEYY))) {
                    DestroyPV(PVField(rel, RRV_DATA_BASE + 4*at + 1));
                }
            at--;
        }
        return;
    } else if (task == RELS_COPY) {
        X = KindConformsTo_POINTER_VALUE_TY(kx); Y = KindConformsTo_POINTER_VALUE_TY(ky);
        if (~~(X || Y)) return;
        at = PVField(rel, RRV_STORAGE);
        while (at >= 0) {
            fl = PVField(rel, RRV_DATA_BASE + 4*at);
            if (fl & RRF_USED) {
                if ((X && (fl & RRF_ENTKEYX)) || (Y && (fl & RRF_ENTKEYY))) {
                    copy the entry key
                    tmp = PVField(rel, RRV_DATA_BASE + 4*at + 1);
                    if (fl & RRF_ENTKEYX)
                        tmp = CopyPV(CreatePV(kx), tmp);
                    else
                        tmp = CopyPV(CreatePV(ky), tmp);
                    WritePVField(rel, RRV_DATA_BASE + 4*at + 1, tmp);
                    update references in X/Y fields pointing here
                    if (fl & RRF_HASX) {
                        at2 = TwoInOneLookUp(rel, kx,
                            PVField(rel, RRV_DATA_BASE + 4*at + 2),
                            RRF_ENTKEYX);
                        if (at2 >= 0)
                            WritePVField(rel, RRV_DATA_BASE + 4*at2 + 3, tmp);
                    }
                    if (fl & RRF_HASY) {
                        at2 = TwoInOneLookUp(rel, ky,
                            PVField(rel, RRV_DATA_BASE + 4*at + 3),
                            RRF_ENTKEYY);
                        if (at2 >= 0)
                            WritePVField(rel, RRV_DATA_BASE + 4*at2 + 2, tmp);
                    }
                }
            }
            at--;
        }
        return;
    } else if (task == RELS_SHOW) {
        print (string) PVField(rel, RRV_DESCRIPTION), ":^";
        if (sym) {
            kind_id = KindComparisonFunction(kx);
            if (~~kind_id) kind_id = UnsignedCompare;
        }
        for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
            fl = PVField(rel, RRV_DATA_BASE + 4*at);
            if ((fl & (RRF_USED+RRF_ENTKEYX+RRF_HASY)) ==
                (RRF_USED+RRF_ENTKEYX+RRF_HASY)) {
                X = PVField(rel, RRV_DATA_BASE + 4*at + 1);
                Y = PVField(rel, RRV_DATA_BASE + 4*at + 3);
                if (sym && kind_id(X, Y) > 0) continue;
                print "  ";
                SayKindValuePair(kx, X);
                if (sym) print " <=> "; else print " >=> ";
                SayKindValuePair(ky, Y);
                print "^";
            }
        }
        return;
    } else if (task == RELS_EMPTY) {
        if (PVField(rel, RRV_USED) == 0) rtrue;
        if (X == 1) {
            TwoInOneHashTableRelationHandler(rel, RELS_DESTROY);
            for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                tmp = RRV_DATA_BASE + 4*at;
                WritePVField(rel, tmp, 0);
                WritePVField(rel, tmp + 1, 0);
                WritePVField(rel, tmp + 2, 0);
                WritePVField(rel, tmp + 3, 0);
            }
            WritePVField(rel, RRV_USED, 0);
            WritePVField(rel, RRV_FILLED, 0);
            rtrue;
        }
        rfalse;
    } else if (task == RELS_LOOKUP_ANY) {
        switch (Y) {
            RLANY_GET_X, RLANY_CAN_GET_X:
                at = TwoInOneLookUp(rel, ky, X, RRF_ENTKEYY);
                if (at >= 0) {
                    tmp = RRV_DATA_BASE + 4*at;
                    if (PVField(rel, tmp) & RRF_HASX) {
                        if (Y == RLANY_CAN_GET_X) rtrue;
                        return PVField(rel, tmp + 2);
                    }
                }
            RLANY_GET_Y, RLANY_CAN_GET_Y:
                at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX);
                if (at >= 0) {
                    tmp = RRV_DATA_BASE + 4*at;
                    if (PVField(rel, tmp) & RRF_HASY) {
                        if (Y == RLANY_CAN_GET_Y) rtrue;
                        return PVField(rel, tmp + 3);
                    }
                }
        }
        if (Y == RLANY_GET_X or RLANY_GET_Y)
            print "*** Lookup failed: value not found ***^";
        rfalse;
    } else if (task == RELS_LOOKUP_ALL_X) {
        at = TwoInOneLookUp(rel, ky, X, RRF_ENTKEYY);
        if (at >= 0) {
            tmp = RRV_DATA_BASE + 4*at;
            if (PVField(rel, tmp) & RRF_HASX)
                LIST_OF_TY_InsertItem(Y, PVField(rel, tmp + 2));
        }
        return Y;
    } else if (task == RELS_LOOKUP_ALL_Y) {
        at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX);
        if (at >= 0) {
            tmp = RRV_DATA_BASE + 4*at;
            if (PVField(rel, tmp) & RRF_HASY)
                LIST_OF_TY_InsertItem(Y, PVField(rel, tmp + 3));
        }
        return Y;
    } else if (task == RELS_LIST) {
        switch (Y) {
            RLIST_ALL_X:
                fl = RRF_USED+RRF_ENTKEYX+RRF_HASY;
                jump ListEntryKeys;
            RLIST_ALL_Y:
                fl = RRF_USED+RRF_ENTKEYY+RRF_HASX;
                .ListEntryKeys;
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 4*at;
                    if ((PVField(rel, tmp) & fl) == fl)
                        LIST_OF_TY_InsertItem(X, PVField(rel, tmp + 1), false, 0, true);
                }
            RLIST_ALL_PAIRS:
                tmp = PVField(X, LIST_ITEM_KOV_F);
                if (KindWeakID(tmp) ~= COMBINATION_TY) rfalse;
                LIST_OF_TY_InsertItem will make a deep copy of the item,
                so we can reuse a single combination value here
                Y = CreatePV(tmp);
                for (at = PVField(rel, RRV_STORAGE): at >= 0: at--) {
                    tmp = RRV_DATA_BASE + 4*at;
                    fl = PVField(rel, tmp);
                    if ((fl & (RRF_USED+RRF_ENTKEYX+RRF_HASY)) ==
                        (RRF_USED+RRF_ENTKEYX+RRF_HASY)) {
                        WritePVField(Y, COMBINATION_ITEM_BASE, PVField(rel, tmp + 1));
                        WritePVField(Y, COMBINATION_ITEM_BASE + 1, PVField(rel, tmp + 3));
                        LIST_OF_TY_InsertItem(X, Y);
                    }
                }
                WritePVField(Y, COMBINATION_ITEM_BASE, 0);
                WritePVField(Y, COMBINATION_ITEM_BASE + 1, 0);
                DestroyPV(Y);
                return X;
        }
        return X;
    }
    at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX);
    switch(task) {
        RELS_TEST:
            if (at < 0) rfalse;
            fl = PVField(rel, RRV_DATA_BASE + 4*at);
            if (~~(fl & RRF_HASY)) rfalse;
            tmp = PVField(rel, RRV_DATA_BASE + 4*at + 3);
            if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                if (ComparePV(tmp, Y) == 0) rtrue;
            } else {
                if (tmp == Y) rtrue;
            }
            rfalse;
        RELS_ASSERT_TRUE:
            if (at < 0) {
                create a new forward entry
                at = ~at;
                WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 1);
                fl = PVField(rel, RRV_DATA_BASE + 4*at);
                if (fl == 0)
                    WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
                fl = RRF_USED+RRF_HASY+RRF_ENTKEYX;
                if (kx == ky || ~~(KindConformsTo_POINTER_VALUE_TY(kx) || KindConformsTo_POINTER_VALUE_TY(ky)))
                    fl = fl + RRF_ENTKEYY;
                WritePVField(rel, RRV_DATA_BASE + 4*at, fl);
                if (KindConformsTo_POINTER_VALUE_TY(kx)) { X = CopyPV(CreatePV(kx), X); }
                WritePVField(rel, RRV_DATA_BASE + 4*at + 1, X);
                WritePVField(rel, RRV_DATA_BASE + 4*at + 2, 0);
            } else {
                fl = PVField(rel, RRV_DATA_BASE + 4*at);
                if (fl & RRF_HASY) {
                    if the Y we're inserting is already there, we're done
                    tmp = PVField(rel, RRV_DATA_BASE + 4*at + 3);
                    if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                        if (ComparePV(tmp, Y) == 0) rtrue;
                    } else {
                        if (tmp == Y) rtrue;
                    }
                    it's different, so delete the reverse entry
                    at2 = TwoInOneLookUp(rel, ky, tmp, RRF_ENTKEYY);
                    if (at2 >= 0) TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY);
                } else {
                    WritePVField(rel, RRV_DATA_BASE + 4*at, fl + RRF_HASY);
                }
                use the existing copy of X
                X = PVField(rel, RRV_DATA_BASE + 4*at + 1);
            }
            use the existing copy of Y if there is one
            at2 = TwoInOneLookUp(rel, ky, Y, RRF_ENTKEYY);
            if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                if (at2 >= 0)
                    Y = PVField(rel, RRV_DATA_BASE + 4*at2 + 1);
                else
                    Y = CopyPV(CreatePV(ky), Y);
            }
            WritePVField(rel, RRV_DATA_BASE + 4*at + 3, Y);
            if (at2 >= 0) {
                delete existing reverse entry (and its own forward entry)
                TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY, 1);
            } else {
                at2 = ~at2;
            }
            create reverse entry
            WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) + 1);
            fl = PVField(rel, RRV_DATA_BASE + 4*at2);
            if (fl == 0)
                WritePVField(rel, RRV_FILLED, PVField(rel, RRV_FILLED) + 1);
            fl = fl | (RRF_USED+RRF_HASX+RRF_ENTKEYY);
            if (kx == ky || ~~(KindConformsTo_POINTER_VALUE_TY(kx) || KindConformsTo_POINTER_VALUE_TY(ky)))
                fl = fl | RRF_ENTKEYX;
            WritePVField(rel, RRV_DATA_BASE + 4*at2, fl);
            WritePVField(rel, RRV_DATA_BASE + 4*at2 + 1, Y);
            WritePVField(rel, RRV_DATA_BASE + 4*at2 + 2, X);
            TwoInOneCheckResize(rel);
            rtrue;
        RELS_ASSERT_FALSE:
            we only have work to do if the entry exists and has a Y which
            matches the Y we're deleting
            if (at < 0) rtrue;
            fl = PVField(rel, RRV_DATA_BASE + 4*at);
            if ((fl & RRF_HASY) == 0) rtrue;
            tmp = PVField(rel, RRV_DATA_BASE + 4*at + 3);
            if (KindConformsTo_POINTER_VALUE_TY(ky)) {
                if (ComparePV(tmp, Y) ~= 0) rtrue;
            } else {
                if (tmp ~= Y) rtrue;
            }
            TwoInOneDelete(rel, at, kx, ky, RRF_ENTKEYX, 1);
            rtrue;
    }
];

[ TwoInOneDelete rel at kx ky ekflag both  fl at2 E i;
rint "[2in1DEL at=", at, " (E=", PVField(rel, RRV_DATA_BASE + 4*at + 1), ") ekflag=", ekflag, " both=", both, "]^";
    fl = PVField(rel, RRV_DATA_BASE + 4*at);
    if (ekflag == RRF_ENTKEYX) {
        if (fl & RRF_HASY) {
            i = RRV_DATA_BASE + 4*at + 3;
            if (both) E = PVField(rel, i);
            WritePVField(rel, i, 0);
            delete matching Y<-X entry if needed
            if (both) {
                at2 = TwoInOneLookUp(rel, ky, E, RRF_ENTKEYY);
                if (at2 >= 0) TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY);
                if (at2 == at) fl = PVField(rel, RRV_DATA_BASE + 4*at);
            }
            fl = fl & ~RRF_HASY;
        }
    } else {
        if (fl & RRF_HASX) {
            i = RRV_DATA_BASE + 4*at + 2;
            if (both) E = PVField(rel, i);
            WritePVField(rel, i, 0);
            delete matching X->Y entry if needed
            if (both) {
                at2 = TwoInOneLookUp(rel, kx, E, RRF_ENTKEYX);
                if (at2 >= 0) {
                    TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYX);
                    if (at2 == at) fl = PVField(rel, RRV_DATA_BASE + 4*at);
                }
            }
            fl = fl & ~RRF_HASX;
        }
    }
    if ((fl & (RRF_HASX+RRF_HASY)) == 0) {
        entry is now empty, mark it deleted
        if (((fl & RRF_ENTKEYX) && KindConformsTo_POINTER_VALUE_TY(kx)) ||
            ((ky ~= kx) && (fl & RRF_ENTKEYY) && KindConformsTo_POINTER_VALUE_TY(ky))) {
            DestroyPV(PVField(rel, RRV_DATA_BASE + 4*at + 1));
        }
        WritePVField(rel, RRV_DATA_BASE + 4*at, RRF_DELETED);
        WritePVField(rel, RRV_DATA_BASE + 4*at + 1, 0);
        WritePVField(rel, RRV_DATA_BASE + 4*at + 2, 0);
        WritePVField(rel, RRV_DATA_BASE + 4*at + 3, 0);
        WritePVField(rel, RRV_USED, PVField(rel, RRV_USED) - 1);
    } else {
        WritePVField(rel, RRV_DATA_BASE + 4*at, fl);
    }
];

[ TwoInOneLookUp rel ke E ekflag  hashv i free mask perturb flags;
rint "[2in1LU rel=", rel, " ke=", ke, " E=", E, " ekf=", ekflag, ": ";
    calculate a hash value for the key
    hashv = HashKindValuePair(ke, E);
    look in the first expected slot
    mask = PVField(rel, RRV_STORAGE);
    i = hashv & mask;
rint "hv=", hashv, ", trying ", i;
    flags = PVField(rel, RRV_DATA_BASE + 4*i);
    if (flags == 0) {
rint " - not found]^";
        return ~i;
    }
    if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) {
rint " - found]^";
        return i;
    }
    not here, keep looking in sequence
    free = -1;
    if (flags & RRF_DELETED) free = i;
    perturb = hashv;
    hashv = i;
    for (::) {
        hashv = hashv*5 + perturb + 1;
        i = hashv & mask;
rint ", ", i;
        flags = PVField(rel, RRV_DATA_BASE + 4*i);
        if (flags == 0) {
rint " - not found]^";
            if (free >= 0) return ~free;
            return ~i;
        }
        if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) {
rint " - found]^";
            return i;
        }
        if ((free < 0) && (flags & RRF_DELETED)) free = i;
        #ifdef TARGET_ZCODE;
        @log_shift perturb MINUS_RRP_PERTURB_SHIFT -> perturb;
        #ifnot;
        @ushiftr perturb RRP_PERTURB_SHIFT perturb;
        #endif;
    }
];

[ TwoInOneCheckResize rel  filled ext newext temp i at kind_id kx ky F E X Y;
    filled = PVField(rel, RRV_FILLED);
    ext = PVField(rel, RRV_STORAGE) + 1;
    if (filled >= (ext - filled) * RRP_CROWDED_IS) {
        copy entries to temporary space
        temp = FlexAllocate(ext * (4*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
        for (i=0: i<ext*4: i++)
            InitialisePVLongBlockField(temp, i, PVField(rel, RRV_DATA_BASE+i));
        resize and clear our data
        if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE;
        else newext = ext * RRP_RESIZE_SMALL;
        SetPVFieldCapacity(rel, RRV_DATA_BASE + newext*4);
        WritePVField(rel, RRV_STORAGE, newext - 1);
        WritePVField(rel, RRV_FILLED, PVField(rel, RRV_USED));
        for (i=0: i<newext*4: i++)
            WritePVField(rel, RRV_DATA_BASE+i, 0);
        copy entries back from temporary space
        kind_id = PVField(rel, RRV_KIND);
        kx = KindConstructorTerm(kind_id, 0); ky = KindConstructorTerm(kind_id, 1);
        for (i=0: i<ext: i++) {
            F = PVLongBlockField(temp, 4*i);
            if (F == 0 || (F & RRF_DELETED)) continue;
            E = PVLongBlockField(temp, 4*i + 1);
            X = PVLongBlockField(temp, 4*i + 2);
            Y = PVLongBlockField(temp, 4*i + 3);
            if (F & RRF_ENTKEYX) at = TwoInOneLookUp(rel, kx, E, RRF_ENTKEYX);
            else at = TwoInOneLookUp(rel, ky, E, RRF_ENTKEYY);
            if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; }
            at = ~at;
            WritePVField(rel, RRV_DATA_BASE + 4*at, F);
            WritePVField(rel, RRV_DATA_BASE + 4*at + 1, E);
            WritePVField(rel, RRV_DATA_BASE + 4*at + 2, X);
            WritePVField(rel, RRV_DATA_BASE + 4*at + 3, Y);
        }
        done with temporary space
        FlexFree(temp);
    }
];

[ TwoInOneEntryMatches rel at ke E  ce;
    ce = PVField(rel, RRV_DATA_BASE + 4*at + 1);
    if (KindConformsTo_POINTER_VALUE_TY(ke)) {
        if (ComparePV(ce, E) ~= 0) rfalse;
    } else {
        if (ce ~= E) rfalse;
    }
    rtrue;
];

§23. Empty. This implements the "empty" adjective. We can always check whether a relation is empty. For most relation types, we can cause the relation to become empty by removing all pairs: but this is impossible for equivalence relations, which are never empty, since any \(X\) is equivalent to itself. And we can never force a relation to become non-empty, since that would require making up data.

In any case, the implementation is delegated to the relation handler. 

[ RELATION_TY_Empty rel set  handler;
    handler = RlnGetF(rel, RR_HANDLER);
    return handler(rel, RELS_EMPTY, set);
];