I6 Template Layer

Inform 7 6M62ContentsIntroductionFunction IndexRules Index

RelationKind.i6t

RelationKind contents

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 BlkValueRead and BlkValueWrite 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.)

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

KOV Support.

See the BlockValues.i6t segment for the specification of the following routines.

37[ RELATION_TY_Support task arg1 arg2 arg3; 38    switch(task) { 39        CREATE_KOVS: return RELATION_TY_Create(arg1, 0, arg2); 40        DESTROY_KOVS: RELATION_TY_Destroy(arg1); 41        MAKEMUTABLE_KOVS: return 1; 42        COPYQUICK_KOVS: rtrue; 43        COPYSB_KOVS: BlkValueCopySB1(arg1, arg2); 44        KINDDATA_KOVS: return 0; 45        EXTENT_KOVS: return -1; 46        COPY_KOVS: RELATION_TY_Copy(arg1, arg2); 47        COMPARE_KOVS: return RELATION_TY_Compare(arg1, arg2); 48        HASH_KOVS: return arg1; 49        DEBUG_KOVS: print " = ", (RELATION_TY_Say) arg1; 50    } 51    ! We choose not to respond to: CAST_KOVS, COPYKIND_KOVS, READ_FILE_KOVS, WRITE_FILE_KOVS 52    rfalse; 53];

Other Definitions.

58! valencies 59Constant RRVAL_V_TO_V 0; 60Constant RRVAL_V_TO_O RELS_Y_UNIQUE; 61Constant RRVAL_O_TO_V RELS_X_UNIQUE; 62Constant RRVAL_O_TO_O RELS_X_UNIQUE+RELS_Y_UNIQUE; 63Constant RRVAL_EQUIV RELS_EQUIVALENCE+RELS_SYMMETRIC; 64Constant RRVAL_SYM_V_TO_V RELS_SYMMETRIC; 65Constant RRVAL_SYM_O_TO_O RELS_SYMMETRIC+RELS_X_UNIQUE+RELS_Y_UNIQUE; 66 67! dictionary entry flags 68Constant RRF_USED $0001; ! entry contains a value 69Constant RRF_DELETED $0002; ! entry used to contain a value 70Constant RRF_SINGLE $0004; ! entry's Y is a value, not a list 71Constant RRF_HASX $0010; ! 2-in-1 entry contains a corresponding key 72Constant RRF_HASY $0020; ! 2-in-1 entry contains a corresponding value 73Constant RRF_ENTKEYX $0040; ! 2-in-1 entry key is left side KOV 74Constant RRF_ENTKEYY $0080; ! 2-in-1 entry key is right side KOV 75 76! permission/task constants (those commented out here are generated by I7) 77!Constant RELS_SYMMETRIC $8000; 78!Constant RELS_EQUIVALENCE $4000; 79!Constant RELS_X_UNIQUE $2000; 80!Constant RELS_Y_UNIQUE $1000; 81!Constant RELS_TEST $0800; 82!Constant RELS_ASSERT_TRUE $0400; 83!Constant RELS_ASSERT_FALSE $0200; 84!Constant RELS_SHOW $0100; 85!Constant RELS_ROUTE_FIND $0080; 86!Constant RELS_ROUTE_FIND_COUNT $0040; 87Constant RELS_COPY $0020; 88Constant RELS_DESTROY $0010; 89!Constant RELS_LOOKUP_ANY $0008; 90!Constant RELS_LOOKUP_ALL_X $0004; 91!Constant RELS_LOOKUP_ALL_Y $0002; 92!Constant RELS_LIST $0001; 93 94Constant RELS_EMPTY $0003; 95Constant RELS_SET_VALENCY $0005; 96 97! RELS_LOOKUP_ANY mode selection constants 98Constant RLANY_GET_X 1; 99Constant RLANY_GET_Y 2; 100Constant RLANY_CAN_GET_X 3; 101Constant RLANY_CAN_GET_Y 4; 102 103! RELS_LIST mode selection constant 104Constant RLIST_ALL_X 1; 105Constant RLIST_ALL_Y 2; 106Constant RLIST_ALL_PAIRS 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.

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

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.

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).

157[ RelationTest relation task X Y handler rv; 158    handler = RlnGetF(relation, RR_HANDLER); 159    return handler(relation, task, X, Y); 160]; 161 162[ RlnGetF rel fld i; 163    rel = BlkValueGetLongBlock(rel); 164    return rel-->fld; 165]; 166 167[ RlnSetF rel fld v; 168    rel = BlkValueGetLongBlock(rel); 169    rel-->fld = v; 170];

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.

178[ EmptyRelationHandler relation task X Y; 179    if (task == RELS_EMPTY) rtrue; 180    rfalse; 181];

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.

209[ RELATION_TY_Create kov from sb rel i skov handler; 210    rel = FlexAllocate((RRV_DATA_BASE + 3*RRP_MIN_SIZE)*WORDSIZE, 211        RELATION_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE); 212    if ((from == 0) && (kov ~= 0)) from = DefaultValueFinder(kov); 213    if (from) { 214        for (i=0: i<RRV_DATA_BASE: i++) BlkValueWrite(rel, i, BlkValueRead(from, i), true); 215        if (BlkValueRead(from, RRV_HANDLER) == EmptyRelationHandler) { 216            handler = ChooseRelationHandler(BlkValueRead(rel, RRV_KIND, true)); 217            BlkValueWrite(rel, RRV_NAME, "anonymous relation", true); 218            BlkValueWrite(rel, RRV_PERMISSIONS, 219                RELS_TEST+RELS_ASSERT_TRUE+RELS_ASSERT_FALSE+RELS_SHOW, true); 220            BlkValueWrite(rel, RRV_HANDLER, handler, true); 221            BlkValueWrite(rel, RRV_STORAGE, RRP_MIN_SIZE-1, true); 222            BlkValueWrite(rel, RRV_DESCRIPTION, "an anonymous relation", true); 223            BlkValueWrite(rel, RRV_USED, 0, true); 224            BlkValueWrite(rel, RRV_FILLED, 0, true); 225        } 226    } else { 227        handler = ChooseRelationHandler(kov); 228        BlkValueWrite(rel, RRV_NAME, "anonymous relation", true); 229        BlkValueWrite(rel, RRV_PERMISSIONS, 230            RELS_TEST+RELS_ASSERT_TRUE+RELS_ASSERT_FALSE+RELS_SHOW, true); 231        BlkValueWrite(rel, RRV_STORAGE, RRP_MIN_SIZE-1, true); 232        BlkValueWrite(rel, RRV_KIND, kov, true); 233        BlkValueWrite(rel, RRV_HANDLER, handler, true); 234        BlkValueWrite(rel, RRV_DESCRIPTION, "an anonymous relation", true); 235        BlkValueWrite(rel, RRV_USED, 0, true); 236        BlkValueWrite(rel, RRV_FILLED, 0, true); 237    } 238 239    return BlkValueCreateSB1(sb, rel); 240];

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.

247[ RELATION_TY_Destroy rel handler; 248    handler = BlkValueRead(rel, RRV_HANDLER); 249    handler(rel, RELS_DESTROY); 250];

Copying.

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

257[ RELATION_TY_Copy lto lfrom handler; 258    handler = BlkValueRead(lto, RRV_HANDLER); 259    handler(lto, RELS_COPY); 260];

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.

268[ RELATION_TY_Compare rleft rright ind1 ind2; 269    ind1 = BlkValueRead(rleft, RRV_HANDLER); 270    ind2 = BlkValueRead(rright, RRV_HANDLER); 271    if (ind1 ~= ind2) return ind1 - ind2; 272    if (IsMutableRelationHandler(ind1) == false) return 0; 273    return rleft - rright; 274]; 275 276[ RELATION_TY_Distinguish rleft rright; 277    if (RELATION_TY_Compare(rleft, rright) == 0) rfalse; 278    rtrue; 279];

Printing.

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

Naming.

292[ RELATION_TY_Name rel txt; 293    if (rel) { 294        BlkValueWrite(rel, RRV_NAME, txt); 295        BlkValueWrite(rel, RRV_DESCRIPTION, txt); 296    } 297];

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.

306[ ChooseRelationHandler kov sym; 307    if (KOVIsBlockValue(KindBaseTerm(kov, 0))) { 308        if (sym) return SymHashListRelationHandler; 309        return HashListRelationHandler; 310    } 311    if (sym) return SymDoubleHashSetRelationHandler; 312    return DoubleHashSetRelationHandler; 313]; 314 315[ IsMutableRelationHandler h; 316    if (h == SymHashListRelationHandler or HashListRelationHandler or 317        SymDoubleHashSetRelationHandler or DoubleHashSetRelationHandler) rtrue; 318    rfalse; 319];

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.

329[ RELATION_TY_SetValency rel val kov filled cur handler ext; 330    filled = BlkValueRead(rel, RRV_FILLED); 331    if (filled) { RunTimeProblem(RTP_RELATIONCHANGEIMPOSSIBLE); rfalse; } 332    kov = BlkValueRead(rel, RRV_KIND); 333    if (val == RRVAL_EQUIV or RRVAL_SYM_V_TO_V or RRVAL_SYM_O_TO_O) { 334        if (KindBaseTerm(kov, 0) ~= KindBaseTerm(kov, 1)) { 335            RunTimeProblem(RTP_RELATIONCHANGEIMPOSSIBLE); rfalse; 336        } 337    } 338    cur = BlkValueRead(rel, RRV_HANDLER); 339    switch (val) { 340        RRVAL_V_TO_V: handler = ChooseRelationHandler(kov, false); 341        RRVAL_V_TO_O: handler = HashTableRelationHandler; 342        RRVAL_O_TO_V: handler = ReversedHashTableRelationHandler; 343        RRVAL_O_TO_O: handler = TwoInOneHashTableRelationHandler; 344        RRVAL_EQUIV: handler = EquivHashTableRelationHandler; 345        RRVAL_SYM_V_TO_V: handler = ChooseRelationHandler(kov, true); 346        RRVAL_SYM_O_TO_O: handler = Sym2in1HashTableRelationHandler; 347        default: RunTimeProblem(RTP_RELATIONCHANGEIMPOSSIBLE); rfalse; 348    } 349    if (cur == handler) rtrue; 350    ! adjust size when going to or from 2-in-1 351    if (cur == TwoInOneHashTableRelationHandler) { 352        ext = BlkValueRead(rel, RRV_STORAGE) + 1; 353        BlkValueSetLBCapacity(rel, RRV_DATA_BASE + 3*ext); 354    } else if (handler == TwoInOneHashTableRelationHandler) { 355        ext = BlkValueRead(rel, RRV_STORAGE) + 1; 356        BlkValueSetLBCapacity(rel, RRV_DATA_BASE + 4*ext); 357    } 358    BlkValueWrite(rel, RRV_HANDLER, handler); 359]; 360 361[ RELATION_TY_GetValency rel handler; 362    return BlkValueRead(rel, RRV_PERMISSIONS) & VALENCY_MASK; 363];

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.

390[ DoubleHashSetRelationHandler rel task X Y sym kov kx ky at tmp v; 391    kov = BlkValueRead(rel, RRV_KIND); 392    kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 393    if (task == RELS_SET_VALENCY) { 394        return RELATION_TY_SetValency(rel, X); 395    } else if (task == RELS_DESTROY) { 396        ! clear 397        kx = KOVIsBlockValue(kx); ky = KOVIsBlockValue(ky); 398        if (~~(kx || ky)) return; 399        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 400            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 401            if (tmp & RRF_USED) { 402                if (kx) BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1)); 403                if (ky) BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2)); 404            } 405            at--; 406        } 407        return; 408    } else if (task == RELS_COPY) { 409        X = KOVIsBlockValue(kx); Y = KOVIsBlockValue(ky); 410        if (~~(X || Y)) return; 411        at = BlkValueRead(rel, RRV_STORAGE); 412        while (at >= 0) { 413            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 414            if (tmp & RRF_USED) { 415                if (X) { 416                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 417                    tmp = BlkValueCopy(BlkValueCreate(kx), tmp); 418                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, tmp); 419                } 420                if (Y) { 421                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 422                    tmp = BlkValueCopy(BlkValueCreate(ky), tmp); 423                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp); 424                } 425            } 426            at--; 427        } 428        return; 429    } else if (task == RELS_SHOW) { 430        print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^"; 431        if (sym) { 432            kov = KOVComparisonFunction(kx); 433            if (~~kov) kov = UnsignedCompare; 434        } 435        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 436            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 437            if (tmp & RRF_USED) { 438                X = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 439                Y = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 440                if (sym && (kov(X, Y) > 0)) continue; 441                print " "; 442                PrintKindValuePair(kx, X); 443                if (sym) print " <=> "; else print " >=> "; 444                PrintKindValuePair(ky, Y); 445                print "^"; 446            } 447        } 448        return; 449    } else if (task == RELS_EMPTY) { 450        if (BlkValueRead(rel, RRV_USED) == 0) rtrue; 451        if (X == 1) { 452            DoubleHashSetRelationHandler(rel, RELS_DESTROY); 453            for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 454                tmp = RRV_DATA_BASE + 3*at; 455                BlkValueWrite(rel, tmp, 0); 456                BlkValueWrite(rel, tmp + 1, 0); 457                BlkValueWrite(rel, tmp + 2, 0); 458            } 459            BlkValueWrite(rel, RRV_USED, 0); 460            BlkValueWrite(rel, RRV_FILLED, 0); 461            rtrue; 462        } 463        rfalse; 464    } else if (task == RELS_LOOKUP_ANY) { 465        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 466            tmp = RRV_DATA_BASE + 3*at; 467            if (BlkValueRead(rel, tmp) & RRF_USED) { 468                if (Y == RLANY_GET_X or RLANY_CAN_GET_X) { 469                    v = BlkValueRead(rel, tmp + 2); 470                    if (KOVIsBlockValue(ky)) { 471                        if (BlkValueCompare(v, X) ~= 0) continue; 472                    } else { 473                        if (v ~= X) continue; 474                    } 475                    if (Y == RLANY_CAN_GET_X) rtrue; 476                    return BlkValueRead(rel, tmp + 1); 477                } else { 478                    v = BlkValueRead(rel, tmp + 1); 479                    if (KOVIsBlockValue(kx)) { 480                        if (BlkValueCompare(v, X) ~= 0) continue; 481                    } else { 482                        if (v ~= X) continue; 483                    } 484                    if (Y == RLANY_CAN_GET_Y) rtrue; 485                    return BlkValueRead(rel, tmp + 2); 486                } 487            } 488        } 489        if (Y == RLANY_GET_X or RLANY_GET_Y) 490            print "*** Lookup failed: value not found ***^"; 491        rfalse; 492    } else if (task == RELS_LOOKUP_ALL_X) { 493        if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse; 494        LIST_OF_TY_SetLength(Y, 0); 495        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 496            tmp = RRV_DATA_BASE + 3*at; 497            if (BlkValueRead(rel, tmp) & RRF_USED) { 498                v = BlkValueRead(rel, tmp + 2); 499                if (KOVIsBlockValue(ky)) { 500                    if (BlkValueCompare(v, X) ~= 0) continue; 501                } else { 502                    if (v ~= X) continue; 503                } 504                LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 1)); 505            } 506        } 507        return Y; 508    } else if (task == RELS_LOOKUP_ALL_Y) { 509        if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse; 510        LIST_OF_TY_SetLength(Y, 0); 511        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 512            tmp = RRV_DATA_BASE + 3*at; 513            if (BlkValueRead(rel, tmp) & RRF_USED) { 514                v = BlkValueRead(rel, tmp + 1); 515                if (KOVIsBlockValue(kx)) { 516                    if (BlkValueCompare(v, X) ~= 0) continue; 517                } else { 518                    if (v ~= X) continue; 519                } 520                LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 2)); 521            } 522        } 523        return Y; 524    } else if (task == RELS_LIST) { 525        if (X == 0 || BlkValueWeakKind(X) ~= LIST_OF_TY) rfalse; 526        LIST_OF_TY_SetLength(X, 0); 527        switch (Y) { 528            RLIST_ALL_X, RLIST_ALL_Y: 529                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 530                    tmp = RRV_DATA_BASE + 3*at; 531                    if (BlkValueRead(rel, tmp) & RRF_USED) { 532                        tmp++; 533                        if (Y == RLIST_ALL_Y) tmp++; 534                        v = BlkValueRead(rel, tmp); 535                        LIST_OF_TY_InsertItem(X, v, false, 0, true); 536                    } 537                } 538                return X; 539            RLIST_ALL_PAIRS: 540                ! LIST_OF_TY_InsertItem will make a deep copy of the item, 541                ! so we can reuse a single combination value here 542                 543                Y = BlkValueCreate(kov); 544                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 545                    tmp = RRV_DATA_BASE + 3*at; 546                    if (BlkValueRead(rel, tmp) & RRF_USED) { 547                        v = BlkValueRead(rel, tmp + 1); 548                        BlkValueWrite(Y, COMBINATION_ITEM_BASE, v); 549                        v = BlkValueRead(rel, tmp + 2); 550                        BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, v); 551                        LIST_OF_TY_InsertItem(X, Y); 552                    } 553                } 554                BlkValueWrite(Y, COMBINATION_ITEM_BASE, 0); 555                BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, 0); 556                BlkValueFree(Y); 557                return X; 558        } 559        rfalse; 560    } 561    at = DoubleHashSetLookUp(rel, kx, ky, X, Y); 562    switch(task) { 563        RELS_TEST: 564            if (at >= 0) rtrue; 565            rfalse; 566        RELS_ASSERT_TRUE: 567            if (at >= 0) rtrue; 568            at = ~at; 569            BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1); 570            if (BlkValueRead(rel, RRV_DATA_BASE + 3*at) == 0) 571                BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 572            BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE); 573            if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); } 574            if (KOVIsBlockValue(ky)) { Y = BlkValueCopy(BlkValueCreate(ky), Y); } 575            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X); 576            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y); 577            DoubleHashSetCheckResize(rel); 578            rtrue; 579        RELS_ASSERT_FALSE: 580            if (at < 0) rtrue; 581            BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1); 582            if (KOVIsBlockValue(kx)) 583                BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1)); 584            if (KOVIsBlockValue(ky)) 585                BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2)); 586            BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_DELETED); 587            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, 0); 588            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, 0); 589            rtrue; 590    } 591]; 592 593[ DoubleHashSetLookUp rel kx ky X Y hashv i free mask perturb flags; 594    ! calculate a hash value for the pair 595    hashv = GetHashValue(kx, x) + GetHashValue(ky, y); 596    ! look in the first expected slot 597    mask = BlkValueRead(rel, RRV_STORAGE); 598    i = hashv & mask; 599    flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i); 600    if (flags == 0) return ~i; 601    if (DoubleHashSetEntryMatches(rel, i, kx, ky, X, Y)) return i; 602    ! not here, keep looking in sequence 603    free = -1; 604    if (flags & RRF_DELETED) free = i; 605    perturb = hashv; 606    hashv = i; 607    for (::) { 608        hashv = hashv*5 + perturb + 1; 609        i = hashv & mask; 610        flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i); 611        if (flags == 0) { 612            if (free >= 0) return ~free; 613            return ~i; 614        } 615        if (DoubleHashSetEntryMatches(rel, i, kx, ky, X, Y)) 616            return i; 617        if ((free < 0) && (flags & RRF_DELETED)) free = i; 618        #ifdef TARGET_ZCODE; 619        @log_shift perturb (-RRP_PERTURB_SHIFT) -> perturb; 620        #ifnot; 621        @ushiftr perturb RRP_PERTURB_SHIFT perturb; 622        #endif; 623    } 624]; 625 626[ DoubleHashSetCheckResize rel filled ext newext temp i at kov kx ky F X Y; 627    filled = BlkValueRead(rel, RRV_FILLED); 628    ext = BlkValueRead(rel, RRV_STORAGE) + 1; 629    if (filled >= (ext - filled) * RRP_CROWDED_IS) { 630        ! copy entries to temporary space 631        temp = FlexAllocate(ext * (3*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE); 632        for (i=0: i<ext*3: i++) 633            BlkValueWrite(temp, i, BlkValueRead(rel, RRV_DATA_BASE+i), true); 634        ! resize and clear our data 635        if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE; 636        else newext = ext * RRP_RESIZE_SMALL; 637        BlkValueSetLBCapacity(rel, RRV_DATA_BASE + newext*3); 638        BlkValueWrite(rel, RRV_STORAGE, newext - 1); 639        BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_USED)); 640        for (i=0: i<newext*3: i++) 641            BlkValueWrite(rel, RRV_DATA_BASE+i, 0); 642        ! copy entries back from temporary space 643        kov = BlkValueRead(rel, RRV_KIND); 644        kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 645        for (i=0: i<ext: i++) { 646            F = BlkValueRead(temp, 3*i, true); 647            if (F == 0 || (F & RRF_DELETED)) continue; 648            X = BlkValueRead(temp, 3*i + 1, true); 649            Y = BlkValueRead(temp, 3*i + 2, true); 650            at = DoubleHashSetLookUp(rel, kx, ky, X, Y); 651            if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; } 652            at = ~at; 653            BlkValueWrite(rel, RRV_DATA_BASE + 3*at, F); 654            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X); 655            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y); 656        } 657        ! done with temporary space 658        FlexFree(temp); 659    } 660]; 661 662[ DoubleHashSetEntryMatches rel at kx ky X Y cx cy; 663    cx = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 664    if (KOVIsBlockValue(kx)) { 665        if (BlkValueCompare(cx, X) ~= 0) rfalse; 666    } else { 667        if (cx ~= X) rfalse; 668    } 669    cy = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 670    if (KOVIsBlockValue(ky)) { 671        if (BlkValueCompare(cy, Y) ~= 0) rfalse; 672    } else { 673        if (cy ~= Y) rfalse; 674    } 675    rtrue; 676];

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.

692[ HashListRelationHandler rel task X Y sym kov kx ky; 693    kov = BlkValueRead(rel, RRV_KIND); 694    kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 695    return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 1); 696];

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.

704[ HashTableRelationHandler rel task X Y kov kx ky; 705    kov = BlkValueRead(rel, RRV_KIND); 706    kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 707    return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 0); 708];

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.

715[ ReversedHashTableRelationHandler rel task X Y kov kx ky swap; 716    kov = BlkValueRead(rel, RRV_KIND); 717    kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 718    switch (task) { 719        RELS_SET_VALENCY: 720            return RELATION_TY_SetValency(rel, X); 721        RELS_TEST, RELS_ASSERT_TRUE, RELS_ASSERT_FALSE: 722            return HashCoreRelationHandler(rel, task, ky, kx, Y, X, 0); 723        RELS_LOOKUP_ANY: 724            switch (Y) { 725                RLANY_GET_X: Y = RLANY_GET_Y; 726                RLANY_GET_Y: Y = RLANY_GET_X; 727                RLANY_CAN_GET_X: Y = RLANY_CAN_GET_Y; 728                RLANY_CAN_GET_Y: Y = RLANY_CAN_GET_X; 729            } 730        RELS_LOOKUP_ALL_X: 731            task = RELS_LOOKUP_ALL_Y; 732        RELS_LOOKUP_ALL_Y: 733            task = RELS_LOOKUP_ALL_X; 734        RELS_SHOW: 735            swap=X; X=Y; Y=swap; 736            swap=kx; kx=ky; ky=swap; 737         RELS_LIST: 738            switch (Y) { 739                RLIST_ALL_X: Y = RLIST_ALL_Y; 740                RLIST_ALL_Y: Y = RLIST_ALL_X; 741            } 742    } 743    return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 0); 744];

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.)

758[ SymDoubleHashSetRelationHandler rel task X Y; 759    if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE) 760        DoubleHashSetRelationHandler(rel, task, Y, X); 761    return DoubleHashSetRelationHandler(rel, task, X, Y, 1); 762]; 763 764[ SymHashListRelationHandler rel task X Y; 765    if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE) 766        HashListRelationHandler(rel, task, Y, X); 767    return HashListRelationHandler(rel, task, X, Y); 768]; 769 770[ Sym2in1HashTableRelationHandler rel task X Y; 771    if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE) 772        TwoInOneHashTableRelationHandler(rel, task, Y, X); 773    return TwoInOneHashTableRelationHandler(rel, task, X, Y, 1); 774];

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).

791[ HashCoreRelationHandler rel task kx ky X Y mult sym rev at tmp fl; 792    if (task == RELS_SET_VALENCY) { 793        return RELATION_TY_SetValency(rel, X); 794    } else if (task == RELS_DESTROY) { 795        ! clear 796        kx = KOVIsBlockValue(kx); ky = KOVIsBlockValue(ky); 797        if (~~(kx || ky)) return; 798        at = BlkValueRead(rel, RRV_STORAGE); 799        while (at >= 0) { 800            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 801            if (fl & RRF_USED) { 802                if (kx) BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1)); 803                if (ky || ~~(fl & RRF_SINGLE)) 804                    BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2)); 805            } 806            at--; 807        } 808        return; 809    } else if (task == RELS_COPY) { 810        X = KOVIsBlockValue(kx); Y = KOVIsBlockValue(ky); 811        if (~~(X || Y)) return; 812        at = BlkValueRead(rel, RRV_STORAGE); 813        while (at >= 0) { 814            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 815            if (fl & RRF_USED) { 816                if (X) { 817                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 818                    tmp = BlkValueCopy(BlkValueCreate(kx), tmp); 819                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, tmp); 820                } 821                if (Y || ~~(fl & RRF_SINGLE)) { 822                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 823                    tmp = BlkValueCopy(BlkValueCreate(BlkValueWeakKind(tmp)), tmp); 824                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp); 825                } 826            } 827            at--; 828        } 829        return; 830    } else if (task == RELS_SHOW) { 831        print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^"; 832        ! Z-machine doesn't have the room to let us pass sym/rev as parameters 833        switch (RELATION_TY_GetValency(rel)) { 834            RRVAL_SYM_V_TO_V: 835                sym = 1; 836                tmp = KOVComparisonFunction(kx); 837                if (~~tmp) tmp = UnsignedCompare; 838            RRVAL_O_TO_V: 839                rev = 1; 840        } 841        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 842            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 843            if (fl & RRF_USED) { 844                X = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 845                Y = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 846                if (fl & RRF_SINGLE) { 847                    if (sym && tmp(X, Y) > 0) continue; 848                    print " "; 849                    if (rev) PrintKindValuePair(ky, Y); 850                    else PrintKindValuePair(kx, X); 851                    if (sym) print " <=> "; else print " >=> "; 852                    if (rev) PrintKindValuePair(kx, X); 853                    else PrintKindValuePair(ky, Y); 854                    print "^"; 855                } else { 856                    for (mult=1: mult<=LIST_OF_TY_GetLength(Y): mult++) { 857                        fl = LIST_OF_TY_GetItem(Y, mult); 858                        if (sym && tmp(X, fl) > 0) continue; 859                        print " "; 860                        if (rev) PrintKindValuePair(ky, fl); 861                        else PrintKindValuePair(kx, X); 862                        if (sym) print " <=> "; else print " >=> "; 863                        if (rev) PrintKindValuePair(kx, X); 864                        else PrintKindValuePair(ky, fl); 865                        print "^"; 866                    } 867                } 868            } 869        } 870        return; 871    } else if (task == RELS_EMPTY) { 872        if (BlkValueRead(rel, RRV_USED) == 0) rtrue; 873        if (X == 1) { 874            HashCoreRelationHandler(rel, RELS_DESTROY); 875            for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 876                tmp = RRV_DATA_BASE + 3*at; 877                BlkValueWrite(rel, tmp, 0); 878                BlkValueWrite(rel, tmp + 1, 0); 879                BlkValueWrite(rel, tmp + 2, 0); 880            } 881            BlkValueWrite(rel, RRV_USED, 0); 882            BlkValueWrite(rel, RRV_FILLED, 0); 883            rtrue; 884        } 885        rfalse; 886    } else if (task == RELS_LOOKUP_ANY) { 887        if (Y == RLANY_GET_Y or RLANY_CAN_GET_Y) { 888            at = HashCoreLookUp(rel, kx, X); 889            if (at >= 0) { 890                if (Y == RLANY_CAN_GET_Y) rtrue; 891                tmp = RRV_DATA_BASE + 3*at; 892                fl = BlkValueRead(rel, tmp); 893                tmp = BlkValueRead(rel, tmp + 2); 894                if (fl & RRF_SINGLE) return tmp; 895                return LIST_OF_TY_GetItem(tmp, 1); 896            } 897        } else { 898            for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 899                tmp = RRV_DATA_BASE + 3*at; 900                fl = BlkValueRead(rel, tmp); 901                if (fl & RRF_USED) { 902                    sym = BlkValueRead(rel, tmp + 2); 903                    if (fl & RRF_SINGLE) { 904                        if (KOVIsBlockValue(ky)) { 905                            if (BlkValueCompare(X, sym) ~= 0) continue; 906                        } else { 907                            if (X ~= sym) continue; 908                        } 909                    } else { 910                        if (LIST_OF_TY_FindItem(sym, X) == 0) continue; 911                    } 912                    if (Y == RLANY_CAN_GET_X) rtrue; 913                    return BlkValueRead(rel, tmp + 1); 914                } 915            } 916        } 917        if (Y == RLANY_GET_X or RLANY_GET_Y) 918            print "*** Lookup failed: value not found ***^"; 919        rfalse; 920    } else if (task == RELS_LOOKUP_ALL_X) { 921        if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse; 922        LIST_OF_TY_SetLength(Y, 0); 923        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 924            tmp = RRV_DATA_BASE + 3*at; 925            fl = BlkValueRead(rel, tmp); 926            if (fl & RRF_USED) { 927                sym = BlkValueRead(rel, tmp + 2); 928                if (fl & RRF_SINGLE) { 929                    if (KOVIsBlockValue(ky)) { 930                        if (BlkValueCompare(X, sym) ~= 0) continue; 931                    } else { 932                        if (X ~= sym) continue; 933                    } 934                } else { 935                    if (LIST_OF_TY_FindItem(sym, X) == 0) continue; 936                } 937                LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 1)); 938            } 939        } 940        return Y; 941    } else if (task == RELS_LOOKUP_ALL_Y) { 942        if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse; 943        LIST_OF_TY_SetLength(Y, 0); 944        at = HashCoreLookUp(rel, kx, X); 945        if (at >= 0) { 946            tmp = RRV_DATA_BASE + 3*at; 947            fl = BlkValueRead(rel, tmp); 948            tmp = BlkValueRead(rel, tmp + 2); 949            if (fl & RRF_SINGLE) 950                LIST_OF_TY_InsertItem(Y, tmp); 951            else 952                LIST_OF_TY_AppendList(Y, tmp); 953        } 954        return Y; 955    } else if (task == RELS_LIST) { 956        if (BlkValueWeakKind(X) ~= LIST_OF_TY) rfalse; 957        LIST_OF_TY_SetLength(X, 0); 958        switch (Y) { 959            RLIST_ALL_X: 960                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 961                    tmp = RRV_DATA_BASE + 3*at; 962                    fl = BlkValueRead(rel, tmp); 963                    if (fl & RRF_USED) 964                        LIST_OF_TY_InsertItem(X, BlkValueRead(rel, tmp + 1)); 965                } 966                return X; 967            RLIST_ALL_Y: 968                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 969                    tmp = RRV_DATA_BASE + 3*at; 970                    fl = BlkValueRead(rel, tmp); 971                    if (fl & RRF_USED) { 972                        tmp = BlkValueRead(rel, tmp + 2); 973                        if (fl & RRF_SINGLE) 974                            LIST_OF_TY_InsertItem(X, tmp, false, 0, true); 975                        else 976                            LIST_OF_TY_AppendList(X, tmp, false, 0, true); 977                    } 978                } 979                return X; 980            RLIST_ALL_PAIRS: 981                if (RELATION_TY_GetValency(rel) == RRVAL_O_TO_V) rev = 1; 982                ! LIST_OF_TY_InsertItem will make a deep copy of the item, 983                ! so we can reuse a single combination value here 984                Y = BlkValueCreate(COMBINATION_TY, tmp); 985                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 986                    tmp = RRV_DATA_BASE + 3*at; 987                    fl = BlkValueRead(rel, tmp); 988                    if (fl & RRF_USED) { 989                        BlkValueWrite(Y, COMBINATION_ITEM_BASE + rev, BlkValueRead(rel, tmp + 1)); 990                        tmp = BlkValueRead(rel, tmp + 2); 991                        if (fl & RRF_SINGLE) { 992                            BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1 - rev, tmp); 993                            LIST_OF_TY_InsertItem(X, Y); 994                        } else { 995                            for (mult = LIST_OF_TY_GetLength(tmp): mult > 0: mult--) { 996                                BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1 - rev, 997                                    LIST_OF_TY_GetItem(tmp, mult)); 998                                LIST_OF_TY_InsertItem(X, Y); 999                            } 1000                        } 1001                    } 1002                } 1003                BlkValueWrite(Y, COMBINATION_ITEM_BASE, 0); 1004                BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, 0); 1005                BlkValueFree(Y); 1006                return X; 1007        } 1008        rfalse; 1009    } 1010    at = HashCoreLookUp(rel, kx, X); 1011    switch(task) { 1012        RELS_TEST: 1013            if (at < 0) rfalse; 1014            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 1015            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 1016            if (fl & RRF_SINGLE) { 1017                if (KOVIsBlockValue(ky)) { 1018                    if (BlkValueCompare(tmp, Y) == 0) rtrue; 1019                } else { 1020                    if (tmp == Y) rtrue; 1021                } 1022                rfalse; 1023            } else { 1024                return LIST_OF_TY_FindItem(tmp, Y); 1025            } 1026        RELS_ASSERT_TRUE: 1027            if (at < 0) { 1028                ! no entry exists for this key, just add one 1029                at = ~at; 1030                BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1); 1031                if (BlkValueRead(rel, RRV_DATA_BASE + 3*at) == 0) 1032                    BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1033                BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE); 1034                if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); } 1035                if (KOVIsBlockValue(ky)) { Y = BlkValueCopy(BlkValueCreate(ky), Y); } 1036                BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X); 1037                BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y); 1038                HashCoreCheckResize(rel); 1039                break; 1040            } 1041            ! an entry exists: could be a list or a single value 1042            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); ! flags 1043            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); ! value or list 1044            if (fl & RRF_SINGLE) { 1045                ! if Y is the same as the stored key, we have nothing to do 1046                if (KOVIsBlockValue(ky)) { 1047                    if (BlkValueCompare(tmp, Y) == 0) rtrue; 1048                } else { 1049                    if (tmp == Y) rtrue; 1050                } 1051                ! it's different: either replace it or expand into a list, 1052                ! depending on the value of mult 1053                if (mult) { 1054                    fl = BlkValueCreate(LIST_OF_TY); ! new list 1055                    BlkValueWrite(fl, LIST_ITEM_KOV_F, ky); 1056                    LIST_OF_TY_SetLength(fl, 2); 1057                    BlkValueWrite(fl, LIST_ITEM_BASE, tmp); ! do not copy 1058                    LIST_OF_TY_PutItem(fl, 2, Y); ! copy if needed 1059                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, fl); 1060                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED); 1061                } else { 1062                    if (KOVIsBlockValue(ky)) { 1063                        BlkValueFree(tmp); 1064                        Y = BlkValueCopy(BlkValueCreate(ky), Y); 1065                    } 1066                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y); 1067                } 1068            } else { 1069                ! if Y is present already, do nothing. otherwise add it. 1070                LIST_OF_TY_InsertItem(tmp, Y, 0, 0, 1); 1071            } 1072            rtrue; 1073        RELS_ASSERT_FALSE: 1074            if (at < 0) rtrue; 1075            ! an entry exists: could be a list or a single value 1076            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); ! flags 1077            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); ! value or list 1078            if (fl & RRF_SINGLE) { 1079                ! if the stored key isn't Y, we have nothing to do 1080                if (KOVIsBlockValue(ky)) { 1081                    if (BlkValueCompare(tmp, Y) ~= 0) rtrue; 1082                } else { 1083                    if (tmp ~= Y) rtrue; 1084                } 1085                ! delete the entry 1086                if (KOVIsBlockValue(ky)) 1087                    BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2)); 1088                .DeleteEntryIgnoringY; 1089                BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1); 1090                if (KOVIsBlockValue(kx)) 1091                    BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1)); 1092                BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_DELETED); 1093                BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, 0); 1094                BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, 0); 1095            } else { 1096                ! remove Y from the list if present 1097                LIST_OF_TY_RemoveValue(tmp, Y, 1); 1098                ! if the list is now empty, delete the whole entry 1099                if (LIST_OF_TY_GetLength(tmp) == 0) { 1100                    BlkValueFree(tmp); 1101                    jump DeleteEntryIgnoringY; 1102                } 1103            } 1104            rtrue; 1105    } 1106    rtrue; 1107]; 1108 1109[ HashCoreLookUp rel kx X hashv i free mask perturb flags; 1110!print "[HCLU rel=", rel, " kx=", kx, " X=", X, ": "; 1111    ! calculate a hash value for the key 1112    hashv = GetHashValue(kx, x); 1113    ! look in the first expected slot 1114    mask = BlkValueRead(rel, RRV_STORAGE); 1115    i = hashv & mask; 1116!print "hv=", hashv, ", trying ", i; 1117    flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i); 1118    if (flags == 0) { 1119!print " - not found]^"; 1120        return ~i; 1121    } 1122    if (HashCoreEntryMatches(rel, i, kx, X)) { 1123!print " - found]^"; 1124        return i; 1125    } 1126    ! not here, keep looking in sequence 1127    free = -1; 1128    if (flags & RRF_DELETED) free = i; 1129    perturb = hashv; 1130    hashv = i; 1131    for (::) { 1132        hashv = hashv*5 + perturb + 1; 1133        i = hashv & mask; 1134!print ", ", i; 1135        flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i); 1136        if (flags == 0) { 1137!print " - not found]^"; 1138            if (free >= 0) return ~free; 1139            return ~i; 1140        } 1141        if (HashCoreEntryMatches(rel, i, kx, X)) { 1142!print " - found]^"; 1143            return i; 1144        } 1145        if ((free < 0) && (flags & RRF_DELETED)) free = i; 1146        #ifdef TARGET_ZCODE; 1147        @log_shift perturb (-RRP_PERTURB_SHIFT) -> perturb; 1148        #ifnot; 1149        @ushiftr perturb RRP_PERTURB_SHIFT perturb; 1150        #endif; 1151    } 1152]; 1153 1154[ HashCoreCheckResize rel filled ext newext temp i at kov kx F X Y; 1155    filled = BlkValueRead(rel, RRV_FILLED); 1156    ext = BlkValueRead(rel, RRV_STORAGE) + 1; 1157    if (filled >= (ext - filled) * RRP_CROWDED_IS) { 1158        ! copy entries to temporary space 1159        temp = FlexAllocate(ext * (3*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE); 1160        for (i=0: i<ext*3: i++) 1161            BlkValueWrite(temp, i, BlkValueRead(rel, RRV_DATA_BASE+i), true); 1162        ! resize and clear our data 1163        if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE; 1164        else newext = ext * RRP_RESIZE_SMALL; 1165        BlkValueSetLBCapacity(rel, RRV_DATA_BASE + newext*3); 1166        BlkValueWrite(rel, RRV_STORAGE, newext - 1); 1167        BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_USED)); 1168        for (i=0: i<newext*3: i++) 1169            BlkValueWrite(rel, RRV_DATA_BASE+i, 0); 1170        ! copy entries back from temporary space 1171        kov = BlkValueRead(rel, RRV_KIND); 1172        kx = KindBaseTerm(kov, 0); 1173        for (i=0: i<ext: i++) { 1174            F = BlkValueRead(temp, 3*i, true); 1175            if (F == 0 || (F & RRF_DELETED)) continue; 1176            X = BlkValueRead(temp, 3*i + 1, true); 1177            Y = BlkValueRead(temp, 3*i + 2, true); 1178            at = HashCoreLookUp(rel, kx, X); 1179            if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; } 1180            at = ~at; 1181            BlkValueWrite(rel, RRV_DATA_BASE + 3*at, F); 1182            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X); 1183            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y); 1184        } 1185        ! done with temporary space 1186        FlexFree(temp); 1187    } 1188]; 1189 1190[ HashCoreEntryMatches rel at kx X cx cy; 1191    cx = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 1192    if (KOVIsBlockValue(kx)) { 1193        if (BlkValueCompare(cx, X) ~= 0) rfalse; 1194    } else { 1195        if (cx ~= X) rfalse; 1196    } 1197    rtrue; 1198];

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.

1231[ EquivHashTableRelationHandler rel task X Y kx at at2 tmp fl i ext; 1232    kx = KindBaseTerm(BlkValueRead(rel, RRV_KIND), 0); 1233    if (task == RELS_SET_VALENCY) { 1234        return RELATION_TY_SetValency(rel, X); 1235    } else if (task == RELS_DESTROY) { 1236        ! clear 1237        if (KOVIsBlockValue(kx)) { 1238            at = BlkValueRead(rel, RRV_STORAGE); 1239            while (at >= 0) { 1240                fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 1241                if (fl & RRF_USED) { 1242                    BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1)); 1243                } 1244                at--; 1245            } 1246        } 1247        return; 1248    } else if (task == RELS_COPY) { 1249        if (KOVIsBlockValue(kx)) { 1250            at = BlkValueRead(rel, RRV_STORAGE); 1251            while (at >= 0) { 1252                fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 1253                if (fl & RRF_USED) { 1254                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1); 1255                    tmp = BlkValueCopy(BlkValueCreate(kx), tmp); 1256                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1); 1257                } 1258                at--; 1259            } 1260        } 1261        return; 1262    } else if (task == RELS_SHOW) { 1263        print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^"; 1264        ext = BlkValueRead(rel, RRV_STORAGE); 1265        ! flag all items by negating their group numbers 1266        for (at=0, X=RRV_DATA_BASE: at<=ext: at++, X=X+3) 1267            if (BlkValueRead(rel, X) & RRF_USED) 1268                BlkValueWrite(rel, X + 2, -(BlkValueRead(rel, X + 2))); 1269        ! display groups, unflagging them as we go 1270        for (at=0, X=RRV_DATA_BASE, fl=0: at<=ext: at++, X=X+3, fl=0) { 1271            if (BlkValueRead(rel, X) & RRF_USED) { 1272                fl = BlkValueRead(rel, X + 2); 1273                if (fl > 0) continue; ! already visited 1274                BlkValueWrite(rel, X + 2, -fl); ! unflag it 1275                ! display the group starting with this member, but only 1276                ! if there are more members in the group 1277                tmp = BlkValueRead(rel, X + 1); 1278                i = 0; 1279                for (at2=at+1, Y=RRV_DATA_BASE+3*at2: at2<=ext: at2++, Y=Y+3) { 1280                    if (BlkValueRead(rel, Y) & RRF_USED) { 1281                        if (BlkValueRead(rel, Y + 2) ~= fl) continue; 1282                        BlkValueWrite(rel, Y + 2, -fl); 1283                        if (~~i) { 1284                            ! print the saved first member 1285                            print " { "; 1286                            PrintKindValuePair(kx, tmp); 1287                            i = 1; 1288                        } 1289                        print ", "; 1290                        PrintKindValuePair(kx, BlkValueRead(rel, Y + 1)); 1291                    } 1292                } 1293                if (i) print " }^"; 1294            } 1295        } 1296        return; 1297    } else if (task == RELS_EMPTY) { 1298        ! never empty since R(x,x) is always true 1299        rfalse; 1300    } else if (task == RELS_LOOKUP_ANY) { 1301        ! kind of a cheat, but it's faster than searching for a better value to return 1302        if (Y == RLANY_CAN_GET_X or RLANY_CAN_GET_Y) rtrue; 1303        return X; 1304    } else if (task == RELS_LOOKUP_ALL_X or RELS_LOOKUP_ALL_Y) { 1305        if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse; 1306        LIST_OF_TY_SetLength(Y, 0); 1307        BlkValueWrite(Y, LIST_ITEM_KOV_F, kx); 1308        at = HashCoreLookUp(rel, kx, X); 1309        if (at < 0) { 1310            LIST_OF_TY_InsertItem(Y, X); 1311        } else { 1312            X = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 1313            for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 1314                tmp = RRV_DATA_BASE + 3*at; 1315                fl = BlkValueRead(rel, tmp); 1316                if (fl & RRF_USED) { 1317                    if (BlkValueRead(rel, tmp + 2) ~= X) continue; 1318                    LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 1)); 1319                } 1320            } 1321        } 1322        return Y; 1323    } else if (task == RELS_LIST) { 1324        print "*** Domains of equivalence relations cannot be listed ***^"; 1325        return X; 1326    } 1327    at = HashCoreLookUp(rel, kx, X); 1328    at2 = HashCoreLookUp(rel, kx, Y); 1329    switch(task) { 1330        RELS_TEST: 1331            if (at < 0) { 1332                ! X is a loner, but could still be true if X == Y 1333                if (KOVIsBlockValue(kx)) { 1334                    if (BlkValueCompare(X, Y) == 0) rtrue; 1335                } else { 1336                    if (X == Y) rtrue; 1337                } 1338                rfalse; 1339            } 1340            if (at2 < 0) rfalse; 1341            if (at == at2) rtrue; 1342            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 1343            if (BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2) == tmp) rtrue; 1344            rfalse; 1345        RELS_ASSERT_TRUE: 1346            ! if X and Y are the same, we have nothing to do 1347            if (KOVIsBlockValue(kx)) { 1348                if (BlkValueCompare(X, Y) == 0) rtrue; 1349            } else { 1350                if (X == Y) rtrue; 1351            } 1352            if (at < 0) { 1353                if (at2 < 0) { 1354                    ! X and Y both missing: find a new group number and add both entries 1355                    tmp = 0; ! candidate group number 1356                    ext = BlkValueRead(rel, RRV_STORAGE); 1357                    for (i=0: i<=ext: i++) { 1358                        fl = BlkValueRead(rel, RRV_DATA_BASE + 3*i); 1359                        if (fl & RRF_USED) { 1360                            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*i + 2); 1361                            if (fl > tmp) tmp = fl; 1362                        } 1363                    } 1364                    tmp++; ! new group number 1365                    BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 2); 1366                    ! add X entry 1367                    at = ~at; 1368                    if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); } 1369                    fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 1370                    if (fl == 0) 1371                        BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1372                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE); 1373                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X); 1374                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp); 1375                    ! add Y entry. at2 might change if X and Y have the same hash code. 1376                    at2 = ~(HashCoreLookUp(rel, kx, Y)); 1377                    if (KOVIsBlockValue(kx)) { Y = BlkValueCopy(BlkValueCreate(kx), Y); } 1378                    fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2); 1379                    if (fl == 0) 1380                        BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1381                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at2, RRF_USED+RRF_SINGLE); 1382                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 1, Y); 1383                    BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 2, tmp); 1384                    jump CheckResize; 1385                } 1386                ! X missing, Y present: add a new X entry 1387                at = ~at; 1388                if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); } 1389                BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1); 1390                fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); 1391                if (fl == 0) 1392                    BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1393                BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE); 1394                BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X); 1395                tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2); 1396                BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp); 1397                jump CheckResize; 1398            } 1399            if (at2 < 0) { 1400                ! X present, Y missing: add a new Y entry 1401                at2 = ~at2; 1402                if (KOVIsBlockValue(kx)) { Y = BlkValueCopy(BlkValueCreate(kx), Y); } 1403                BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1); 1404                fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2); 1405                if (fl == 0) 1406                    BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1407                BlkValueWrite(rel, RRV_DATA_BASE + 3*at2, RRF_USED+RRF_SINGLE); 1408                BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 1, Y); 1409                tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 1410                BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 2, tmp); 1411                jump CheckResize; 1412            } 1413            ! X and Y both present: merge higher group into lower group 1414            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); ! higher group 1415            fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2); ! lower group 1416            if (tmp < fl) { i = tmp; tmp = fl; fl = i; } 1417            ext = BlkValueRead(rel, RRV_STORAGE); 1418            for (at=0: at<=ext: at++) { 1419                i = RRV_DATA_BASE + 3*at + 2; 1420                if (BlkValueRead(rel, i) == tmp) 1421                    BlkValueWrite(rel, i, fl); 1422            } 1423            .CheckResize; 1424            HashCoreCheckResize(rel); 1425            rtrue; 1426        RELS_ASSERT_FALSE: 1427            ! if X and Y are already in different groups, we have nothing to do 1428            if (at < 0 || at2 < 0) rtrue; 1429            tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); 1430            if (BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2) ~= tmp) rtrue; 1431            ! delete the entry for X 1432            BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1); 1433            if (KOVIsBlockValue(kx)) 1434                BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1)); 1435            BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_DELETED); 1436            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, 0); 1437            BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, 0); 1438            rtrue; 1439    } 1440];

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.)

1483[ TwoInOneHashTableRelationHandler rel task X Y sym kov kx ky at at2 tmp fl; 1484    kov = BlkValueRead(rel, RRV_KIND); 1485    kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 1486    if (task == RELS_SET_VALENCY) { 1487        return RELATION_TY_SetValency(rel, X); 1488    } else if (task == RELS_DESTROY) { 1489        ! clear 1490        kx = KOVIsBlockValue(kx); ky = KOVIsBlockValue(ky); 1491        if (~~(kx || ky)) return; 1492        at = BlkValueRead(rel, RRV_STORAGE); 1493        while (at >= 0) { 1494            fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1495            if (fl & RRF_USED) 1496                if ((kx && (fl & RRF_ENTKEYX)) || (ky && (fl & RRF_ENTKEYY))) { 1497                    BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1)); 1498                } 1499            at--; 1500        } 1501        return; 1502    } else if (task == RELS_COPY) { 1503        X = KOVIsBlockValue(kx); Y = KOVIsBlockValue(ky); 1504        if (~~(X || Y)) return; 1505        at = BlkValueRead(rel, RRV_STORAGE); 1506        while (at >= 0) { 1507            fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1508            if (fl & RRF_USED) { 1509                if ((X && (fl & RRF_ENTKEYX)) || (Y && (fl & RRF_ENTKEYY))) { 1510                    ! copy the entry key 1511                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1); 1512                    if (fl & RRF_ENTKEYX) 1513                        tmp = BlkValueCopy(BlkValueCreate(kx), tmp); 1514                    else 1515                        tmp = BlkValueCopy(BlkValueCreate(ky), tmp); 1516                    BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, tmp); 1517                    ! update references in X/Y fields pointing here 1518                    if (fl & RRF_HASX) { 1519                        at2 = TwoInOneLookUp(rel, kx, 1520                            BlkValueRead(rel, RRV_DATA_BASE + 4*at + 2), 1521                            RRF_ENTKEYX); 1522                        if (at2 >= 0) 1523                            BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 3, tmp); 1524                    } 1525                    if (fl & RRF_HASY) { 1526                        at2 = TwoInOneLookUp(rel, ky, 1527                            BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3), 1528                            RRF_ENTKEYY); 1529                        if (at2 >= 0) 1530                            BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 2, tmp); 1531                    } 1532                } 1533            } 1534            at--; 1535        } 1536        return; 1537    } else if (task == RELS_SHOW) { 1538        print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^"; 1539        if (sym) { 1540            kov = KOVComparisonFunction(kx); 1541            if (~~kov) kov = UnsignedCompare; 1542        } 1543        for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 1544            fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1545            if ((fl & (RRF_USED+RRF_ENTKEYX+RRF_HASY)) == 1546                (RRF_USED+RRF_ENTKEYX+RRF_HASY)) { 1547                X = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1); 1548                Y = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3); 1549                if (sym && kov(X, Y) > 0) continue; 1550                print " "; 1551                PrintKindValuePair(kx, X); 1552                if (sym) print " <=> "; else print " >=> "; 1553                PrintKindValuePair(ky, Y); 1554                print "^"; 1555            } 1556        } 1557        return; 1558    } else if (task == RELS_EMPTY) { 1559        if (BlkValueRead(rel, RRV_USED) == 0) rtrue; 1560        if (X == 1) { 1561            TwoInOneHashTableRelationHandler(rel, RELS_DESTROY); 1562            for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 1563                tmp = RRV_DATA_BASE + 4*at; 1564                BlkValueWrite(rel, tmp, 0); 1565                BlkValueWrite(rel, tmp + 1, 0); 1566                BlkValueWrite(rel, tmp + 2, 0); 1567                BlkValueWrite(rel, tmp + 3, 0); 1568            } 1569            BlkValueWrite(rel, RRV_USED, 0); 1570            BlkValueWrite(rel, RRV_FILLED, 0); 1571            rtrue; 1572        } 1573        rfalse; 1574    } else if (task == RELS_LOOKUP_ANY) { 1575        switch (Y) { 1576            RLANY_GET_X, RLANY_CAN_GET_X: 1577                at = TwoInOneLookUp(rel, ky, X, RRF_ENTKEYY); 1578                if (at >= 0) { 1579                    tmp = RRV_DATA_BASE + 4*at; 1580                    if (BlkValueRead(rel, tmp) & RRF_HASX) { 1581                        if (Y == RLANY_CAN_GET_X) rtrue; 1582                        return BlkValueRead(rel, tmp + 2); 1583                    } 1584                } 1585            RLANY_GET_Y, RLANY_CAN_GET_Y: 1586                at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX); 1587                if (at >= 0) { 1588                    tmp = RRV_DATA_BASE + 4*at; 1589                    if (BlkValueRead(rel, tmp) & RRF_HASY) { 1590                        if (Y == RLANY_CAN_GET_Y) rtrue; 1591                        return BlkValueRead(rel, tmp + 3); 1592                    } 1593                } 1594        } 1595        if (Y == RLANY_GET_X or RLANY_GET_Y) 1596            print "*** Lookup failed: value not found ***^"; 1597        rfalse; 1598    } else if (task == RELS_LOOKUP_ALL_X) { 1599        at = TwoInOneLookUp(rel, ky, X, RRF_ENTKEYY); 1600        if (at >= 0) { 1601            tmp = RRV_DATA_BASE + 4*at; 1602            if (BlkValueRead(rel, tmp) & RRF_HASX) 1603                LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 2)); 1604        } 1605        return Y; 1606    } else if (task == RELS_LOOKUP_ALL_Y) { 1607        at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX); 1608        if (at >= 0) { 1609            tmp = RRV_DATA_BASE + 4*at; 1610            if (BlkValueRead(rel, tmp) & RRF_HASY) 1611                LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 3)); 1612        } 1613        return Y; 1614    } else if (task == RELS_LIST) { 1615        switch (Y) { 1616            RLIST_ALL_X: 1617                fl = RRF_USED+RRF_ENTKEYX+RRF_HASY; 1618                jump ListEntryKeys; 1619            RLIST_ALL_Y: 1620                fl = RRF_USED+RRF_ENTKEYY+RRF_HASX; 1621                .ListEntryKeys; 1622                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 1623                    tmp = RRV_DATA_BASE + 4*at; 1624                    if ((BlkValueRead(rel, tmp) & fl) == fl) 1625                        LIST_OF_TY_InsertItem(X, BlkValueRead(rel, tmp + 1), false, 0, true); 1626                } 1627            RLIST_ALL_PAIRS: 1628                tmp = BlkValueRead(X, LIST_ITEM_KOV_F); 1629                if (KindAtomic(tmp) ~= COMBINATION_TY) rfalse; 1630                ! LIST_OF_TY_InsertItem will make a deep copy of the item, 1631                ! so we can reuse a single combination value here 1632                Y = BlkValueCreate(tmp); 1633                for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) { 1634                    tmp = RRV_DATA_BASE + 4*at; 1635                    fl = BlkValueRead(rel, tmp); 1636                    if ((fl & (RRF_USED+RRF_ENTKEYX+RRF_HASY)) == 1637                        (RRF_USED+RRF_ENTKEYX+RRF_HASY)) { 1638                        BlkValueWrite(Y, COMBINATION_ITEM_BASE, BlkValueRead(rel, tmp + 1)); 1639                        BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, BlkValueRead(rel, tmp + 3)); 1640                        LIST_OF_TY_InsertItem(X, Y); 1641                    } 1642                } 1643                BlkValueWrite(Y, COMBINATION_ITEM_BASE, 0); 1644                BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, 0); 1645                BlkValueFree(Y); 1646                return X; 1647        } 1648        return X; 1649    } 1650    at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX); 1651    switch(task) { 1652        RELS_TEST: 1653            if (at < 0) rfalse; 1654            fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1655            if (~~(fl & RRF_HASY)) rfalse; 1656            tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3); 1657            if (KOVIsBlockValue(ky)) { 1658                if (BlkValueCompare(tmp, Y) == 0) rtrue; 1659            } else { 1660                if (tmp == Y) rtrue; 1661            } 1662            rfalse; 1663        RELS_ASSERT_TRUE: 1664            if (at < 0) { 1665                ! create a new forward entry 1666                at = ~at; 1667                BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1); 1668                fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1669                if (fl == 0) 1670                    BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1671                fl = RRF_USED+RRF_HASY+RRF_ENTKEYX; 1672                if (kx == ky || ~~(KOVIsBlockValue(kx) || KOVIsBlockValue(ky))) 1673                    fl = fl + RRF_ENTKEYY; 1674                BlkValueWrite(rel, RRV_DATA_BASE + 4*at, fl); 1675                if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); } 1676                BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, X); 1677                BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 2, 0); 1678            } else { 1679                fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1680                if (fl & RRF_HASY) { 1681                    ! if the Y we're inserting is already there, we're done 1682                    tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3); 1683                    if (KOVIsBlockValue(ky)) { 1684                        if (BlkValueCompare(tmp, Y) == 0) rtrue; 1685                    } else { 1686                        if (tmp == Y) rtrue; 1687                    } 1688                    ! it's different, so delete the reverse entry 1689                    at2 = TwoInOneLookUp(rel, ky, tmp, RRF_ENTKEYY); 1690                    if (at2 >= 0) TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY); 1691                } else { 1692                    BlkValueWrite(rel, RRV_DATA_BASE + 4*at, fl + RRF_HASY); 1693                } 1694                ! use the existing copy of X 1695                X = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1); 1696            } 1697            ! use the existing copy of Y if there is one 1698            at2 = TwoInOneLookUp(rel, ky, Y, RRF_ENTKEYY); 1699            if (KOVIsBlockValue(ky)) { 1700                if (at2 >= 0) 1701                    Y = BlkValueRead(rel, RRV_DATA_BASE + 4*at2 + 1); 1702                else 1703                    Y = BlkValueCopy(BlkValueCreate(ky), Y); 1704            } 1705            BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 3, Y); 1706            if (at2 >= 0) { 1707                ! delete existing reverse entry (and its own forward entry) 1708                TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY, 1); 1709            } else { 1710                at2 = ~at2; 1711            } 1712            ! create reverse entry 1713            BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1); 1714            fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at2); 1715            if (fl == 0) 1716                BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1); 1717            fl = fl | (RRF_USED+RRF_HASX+RRF_ENTKEYY); 1718            if (kx == ky || ~~(KOVIsBlockValue(kx) || KOVIsBlockValue(ky))) 1719                fl = fl | RRF_ENTKEYX; 1720            BlkValueWrite(rel, RRV_DATA_BASE + 4*at2, fl); 1721            BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 1, Y); 1722            BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 2, X); 1723            TwoInOneCheckResize(rel); 1724            rtrue; 1725        RELS_ASSERT_FALSE: 1726            ! we only have work to do if the entry exists and has a Y which 1727            ! matches the Y we're deleting 1728            if (at < 0) rtrue; 1729            fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1730            if ((fl & RRF_HASY) == 0) rtrue; 1731            tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3); 1732            if (KOVIsBlockValue(ky)) { 1733                if (BlkValueCompare(tmp, Y) ~= 0) rtrue; 1734            } else { 1735                if (tmp ~= Y) rtrue; 1736            } 1737            TwoInOneDelete(rel, at, kx, ky, RRF_ENTKEYX, 1); 1738            rtrue; 1739    } 1740]; 1741 1742[ TwoInOneDelete rel at kx ky ekflag both fl at2 E i; 1743!print "[2in1DEL at=", at, " (E=", BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1), ") ekflag=", ekflag, " both=", both, "]^"; 1744    fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1745    if (ekflag == RRF_ENTKEYX) { 1746        if (fl & RRF_HASY) { 1747            i = RRV_DATA_BASE + 4*at + 3; 1748            if (both) E = BlkValueRead(rel, i); 1749            BlkValueWrite(rel, i, 0); 1750            ! delete matching Y<-X entry if needed 1751            if (both) { 1752                at2 = TwoInOneLookUp(rel, ky, E, RRF_ENTKEYY); 1753                if (at2 >= 0) TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY); 1754                if (at2 == at) fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1755            } 1756            fl = fl & ~RRF_HASY; 1757        } 1758    } else { 1759        if (fl & RRF_HASX) { 1760            i = RRV_DATA_BASE + 4*at + 2; 1761            if (both) E = BlkValueRead(rel, i); 1762            BlkValueWrite(rel, i, 0); 1763            ! delete matching X->Y entry if needed 1764            if (both) { 1765                at2 = TwoInOneLookUp(rel, kx, E, RRF_ENTKEYX); 1766                if (at2 >= 0) { 1767                    TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYX); 1768                    if (at2 == at) fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at); 1769                } 1770            } 1771            fl = fl & ~RRF_HASX; 1772        } 1773    } 1774    if ((fl & (RRF_HASX+RRF_HASY)) == 0) { 1775        ! entry is now empty, mark it deleted 1776        if (((fl & RRF_ENTKEYX) && KOVIsBlockValue(kx)) || 1777            ((ky ~= kx) && (fl & RRF_ENTKEYY) && KOVIsBlockValue(ky))) { 1778            BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1)); 1779        } 1780        BlkValueWrite(rel, RRV_DATA_BASE + 4*at, RRF_DELETED); 1781        BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, 0); 1782        BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 2, 0); 1783        BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 3, 0); 1784        BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1); 1785    } else { 1786        BlkValueWrite(rel, RRV_DATA_BASE + 4*at, fl); 1787    } 1788]; 1789 1790[ TwoInOneLookUp rel ke E ekflag hashv i free mask perturb flags; 1791!print "[2in1LU rel=", rel, " ke=", ke, " E=", E, " ekf=", ekflag, ": "; 1792    ! calculate a hash value for the key 1793    hashv = GetHashValue(ke, E); 1794    ! look in the first expected slot 1795    mask = BlkValueRead(rel, RRV_STORAGE); 1796    i = hashv & mask; 1797!print "hv=", hashv, ", trying ", i; 1798    flags = BlkValueRead(rel, RRV_DATA_BASE + 4*i); 1799    if (flags == 0) { 1800!print " - not found]^"; 1801        return ~i; 1802    } 1803    if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) { 1804!print " - found]^"; 1805        return i; 1806    } 1807    ! not here, keep looking in sequence 1808    free = -1; 1809    if (flags & RRF_DELETED) free = i; 1810    perturb = hashv; 1811    hashv = i; 1812    for (::) { 1813        hashv = hashv*5 + perturb + 1; 1814        i = hashv & mask; 1815!print ", ", i; 1816        flags = BlkValueRead(rel, RRV_DATA_BASE + 4*i); 1817        if (flags == 0) { 1818!print " - not found]^"; 1819            if (free >= 0) return ~free; 1820            return ~i; 1821        } 1822        if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) { 1823!print " - found]^"; 1824            return i; 1825        } 1826        if ((free < 0) && (flags & RRF_DELETED)) free = i; 1827        #ifdef TARGET_ZCODE; 1828        @log_shift perturb (-RRP_PERTURB_SHIFT) -> perturb; 1829        #ifnot; 1830        @ushiftr perturb RRP_PERTURB_SHIFT perturb; 1831        #endif; 1832    } 1833]; 1834 1835[ TwoInOneCheckResize rel filled ext newext temp i at kov kx ky F E X Y; 1836    filled = BlkValueRead(rel, RRV_FILLED); 1837    ext = BlkValueRead(rel, RRV_STORAGE) + 1; 1838    if (filled >= (ext - filled) * RRP_CROWDED_IS) { 1839        ! copy entries to temporary space 1840        temp = FlexAllocate(ext * (4*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE); 1841        for (i=0: i<ext*4: i++) 1842            BlkValueWrite(temp, i, BlkValueRead(rel, RRV_DATA_BASE+i), true); 1843        ! resize and clear our data 1844        if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE; 1845        else newext = ext * RRP_RESIZE_SMALL; 1846        BlkValueSetLBCapacity(rel, RRV_DATA_BASE + newext*4); 1847        BlkValueWrite(rel, RRV_STORAGE, newext - 1); 1848        BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_USED)); 1849        for (i=0: i<newext*4: i++) 1850            BlkValueWrite(rel, RRV_DATA_BASE+i, 0); 1851        ! copy entries back from temporary space 1852        kov = BlkValueRead(rel, RRV_KIND); 1853        kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1); 1854        for (i=0: i<ext: i++) { 1855            F = BlkValueRead(temp, 4*i, true); 1856            if (F == 0 || (F & RRF_DELETED)) continue; 1857            E = BlkValueRead(temp, 4*i + 1, true); 1858            X = BlkValueRead(temp, 4*i + 2, true); 1859            Y = BlkValueRead(temp, 4*i + 3, true); 1860            if (F & RRF_ENTKEYX) at = TwoInOneLookUp(rel, kx, E, RRF_ENTKEYX); 1861            else at = TwoInOneLookUp(rel, ky, E, RRF_ENTKEYY); 1862            if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; } 1863            at = ~at; 1864            BlkValueWrite(rel, RRV_DATA_BASE + 4*at, F); 1865            BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, E); 1866            BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 2, X); 1867            BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 3, Y); 1868        } 1869        ! done with temporary space 1870        FlexFree(temp); 1871    } 1872]; 1873 1874[ TwoInOneEntryMatches rel at ke E ce; 1875    ce = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1); 1876    if (KOVIsBlockValue(ke)) { 1877        if (BlkValueCompare(ce, E) ~= 0) rfalse; 1878    } else { 1879        if (ce ~= E) rfalse; 1880    } 1881    rtrue; 1882];

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.

1894[ RELATION_TY_Empty rel set handler; 1895    handler = RlnGetF(rel, RR_HANDLER); 1896    return handler(rel, RELS_EMPTY, set); 1897];