RelationKind contents
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;
23Constant RRV_PERMISSIONS RR_PERMISSIONS-5;
24Constant RRV_STORAGE RR_STORAGE-5;
25Constant RRV_KIND RR_KIND-5;
26Constant RRV_HANDLER RR_HANDLER-5;
27Constant RRV_DESCRIPTION RR_DESCRIPTION-5;
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
52 rfalse;
53];
58
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
68Constant RRF_USED $0001;
69Constant RRF_DELETED $0002;
70Constant RRF_SINGLE $0004;
71Constant RRF_HASX $0010;
72Constant RRF_HASY $0020;
73Constant RRF_ENTKEYX $0040;
74Constant RRF_ENTKEYY $0080;
75
76
77
78
79
80
81
82
83
84
85
86
87Constant RELS_COPY $0020;
88Constant RELS_DESTROY $0010;
89
90
91
92
93
94Constant RELS_EMPTY $0003;
95Constant RELS_SET_VALENCY $0005;
96
97
98Constant RLANY_GET_X 1;
99Constant RLANY_GET_Y 2;
100Constant RLANY_CAN_GET_X 3;
101Constant RLANY_CAN_GET_Y 4;
102
103
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;
118Constant RRP_PERTURB_SHIFT 5;
119Constant RRP_RESIZE_SMALL 4;
120Constant RRP_RESIZE_LARGE 2;
121Constant RRP_LARGE_IS 256;
122Constant RRP_CROWDED_IS 2;
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];
284[ RELATION_TY_Say rel;
285 if (rel == 0) print "(null relation)";
286 else print (string) RlnGetF(rel, RR_NAME);
287];
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
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
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
541
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
595 hashv = GetHashValue(kx, x) + GetHashValue(ky, y);
596
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
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
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
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
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
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
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
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
983
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
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
1042 fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
1043 tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
1044 if (fl & RRF_SINGLE) {
1045
1046 if (KOVIsBlockValue(ky)) {
1047 if (BlkValueCompare(tmp, Y) == 0) rtrue;
1048 } else {
1049 if (tmp == Y) rtrue;
1050 }
1051
1052
1053 if (mult) {
1054 fl = BlkValueCreate(LIST_OF_TY);
1055 BlkValueWrite(fl, LIST_ITEM_KOV_F, ky);
1056 LIST_OF_TY_SetLength(fl, 2);
1057 BlkValueWrite(fl, LIST_ITEM_BASE, tmp);
1058 LIST_OF_TY_PutItem(fl, 2, Y);
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
1070 LIST_OF_TY_InsertItem(tmp, Y, 0, 0, 1);
1071 }
1072 rtrue;
1073 RELS_ASSERT_FALSE:
1074 if (at < 0) rtrue;
1075
1076 fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
1077 tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
1078 if (fl & RRF_SINGLE) {
1079
1080 if (KOVIsBlockValue(ky)) {
1081 if (BlkValueCompare(tmp, Y) ~= 0) rtrue;
1082 } else {
1083 if (tmp ~= Y) rtrue;
1084 }
1085
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
1097 LIST_OF_TY_RemoveValue(tmp, Y, 1);
1098
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
1111
1112 hashv = GetHashValue(kx, x);
1113
1114 mask = BlkValueRead(rel, RRV_STORAGE);
1115 i = hashv & mask;
1116
1117 flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
1118 if (flags == 0) {
1119
1120 return ~i;
1121 }
1122 if (HashCoreEntryMatches(rel, i, kx, X)) {
1123
1124 return i;
1125 }
1126
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
1135 flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
1136 if (flags == 0) {
1137
1138 if (free >= 0) return ~free;
1139 return ~i;
1140 }
1141 if (HashCoreEntryMatches(rel, i, kx, X)) {
1142
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
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
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
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
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
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
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
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;
1274 BlkValueWrite(rel, X + 2, -fl);
1275
1276
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
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
1299 rfalse;
1300 } else if (task == RELS_LOOKUP_ANY) {
1301
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
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
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
1355 tmp = 0;
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++;
1365 BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 2);
1366
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
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
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
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
1414 tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
1415 fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2);
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
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
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
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
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
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
1631
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
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
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
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
1695 X = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1);
1696 }
1697
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
1708 TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY, 1);
1709 } else {
1710 at2 = ~at2;
1711 }
1712
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
1727
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
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
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
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
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
1792
1793 hashv = GetHashValue(ke, E);
1794
1795 mask = BlkValueRead(rel, RRV_STORAGE);
1796 i = hashv & mask;
1797
1798 flags = BlkValueRead(rel, RRV_DATA_BASE + 4*i);
1799 if (flags == 0) {
1800
1801 return ~i;
1802 }
1803 if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) {
1804
1805 return i;
1806 }
1807
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
1816 flags = BlkValueRead(rel, RRV_DATA_BASE + 4*i);
1817 if (flags == 0) {
1818
1819 if (free >= 0) return ~free;
1820 return ~i;
1821 }
1822 if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) {
1823
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
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
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
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
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];