mirror of
https://github.com/ganelson/inform.git
synced 2024-07-09 02:24:21 +03:00
1898 lines
65 KiB
Plaintext
1898 lines
65 KiB
Plaintext
B/relkt: Relation Kind Template.
|
|
|
|
@Purpose: Code to support the relation kind.
|
|
|
|
@-------------------------------------------------------------------------------
|
|
|
|
@p 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.)
|
|
|
|
@c
|
|
Constant RRV_NAME RR_NAME-5; ! Packed string, e.g. "containment relation"
|
|
Constant RRV_PERMISSIONS RR_PERMISSIONS-5; ! A bitmap of what operations this supports
|
|
Constant RRV_STORAGE RR_STORAGE-5; ! Data location, depending on format
|
|
Constant RRV_KIND RR_KIND-5; ! Strong kind ID of the relation
|
|
Constant RRV_HANDLER RR_HANDLER-5; ! Routine to perform operations on this
|
|
Constant RRV_DESCRIPTION RR_DESCRIPTION-5; ! Packed string, e.g. "contains"
|
|
Constant RRV_USED 6;
|
|
Constant RRV_FILLED 7;
|
|
Constant RRV_DATA_BASE 8;
|
|
|
|
@p KOV Support.
|
|
See the "BlockValues.i6t" segment for the specification of the following
|
|
routines.
|
|
|
|
@c
|
|
[ RELATION_TY_Support task arg1 arg2 arg3;
|
|
switch(task) {
|
|
CREATE_KOVS: return RELATION_TY_Create(arg1, 0, arg2);
|
|
DESTROY_KOVS: RELATION_TY_Destroy(arg1);
|
|
MAKEMUTABLE_KOVS: return 1;
|
|
COPYQUICK_KOVS: rtrue;
|
|
COPYSB_KOVS: BlkValueCopySB1(arg1, arg2);
|
|
KINDDATA_KOVS: return 0;
|
|
EXTENT_KOVS: return -1;
|
|
COPY_KOVS: RELATION_TY_Copy(arg1, arg2);
|
|
COMPARE_KOVS: return RELATION_TY_Compare(arg1, arg2);
|
|
HASH_KOVS: return arg1;
|
|
DEBUG_KOVS: print " = ", (RELATION_TY_Say) arg1;
|
|
}
|
|
! We choose not to respond to: CAST_KOVS, COPYKIND_KOVS, READ_FILE_KOVS, WRITE_FILE_KOVS
|
|
rfalse;
|
|
];
|
|
|
|
@p Other Definitions.
|
|
|
|
@c
|
|
! valencies
|
|
Constant RRVAL_V_TO_V 0;
|
|
Constant RRVAL_V_TO_O RELS_Y_UNIQUE;
|
|
Constant RRVAL_O_TO_V RELS_X_UNIQUE;
|
|
Constant RRVAL_O_TO_O RELS_X_UNIQUE+RELS_Y_UNIQUE;
|
|
Constant RRVAL_EQUIV RELS_EQUIVALENCE+RELS_SYMMETRIC;
|
|
Constant RRVAL_SYM_V_TO_V RELS_SYMMETRIC;
|
|
Constant RRVAL_SYM_O_TO_O RELS_SYMMETRIC+RELS_X_UNIQUE+RELS_Y_UNIQUE;
|
|
|
|
! dictionary entry flags
|
|
Constant RRF_USED $0001; ! entry contains a value
|
|
Constant RRF_DELETED $0002; ! entry used to contain a value
|
|
Constant RRF_SINGLE $0004; ! entry's Y is a value, not a list
|
|
Constant RRF_HASX $0010; ! 2-in-1 entry contains a corresponding key
|
|
Constant RRF_HASY $0020; ! 2-in-1 entry contains a corresponding value
|
|
Constant RRF_ENTKEYX $0040; ! 2-in-1 entry key is left side KOV
|
|
Constant RRF_ENTKEYY $0080; ! 2-in-1 entry key is right side KOV
|
|
|
|
! permission/task constants (those commented out here are generated by I7)
|
|
!Constant RELS_SYMMETRIC $8000;
|
|
!Constant RELS_EQUIVALENCE $4000;
|
|
!Constant RELS_X_UNIQUE $2000;
|
|
!Constant RELS_Y_UNIQUE $1000;
|
|
!Constant RELS_TEST $0800;
|
|
!Constant RELS_ASSERT_TRUE $0400;
|
|
!Constant RELS_ASSERT_FALSE $0200;
|
|
!Constant RELS_SHOW $0100;
|
|
!Constant RELS_ROUTE_FIND $0080;
|
|
!Constant RELS_ROUTE_FIND_COUNT $0040;
|
|
Constant RELS_COPY $0020;
|
|
Constant RELS_DESTROY $0010;
|
|
!Constant RELS_LOOKUP_ANY $0008;
|
|
!Constant RELS_LOOKUP_ALL_X $0004;
|
|
!Constant RELS_LOOKUP_ALL_Y $0002;
|
|
!Constant RELS_LIST $0001;
|
|
|
|
Constant RELS_EMPTY $0003;
|
|
Constant RELS_SET_VALENCY $0005;
|
|
|
|
! RELS_LOOKUP_ANY mode selection constants
|
|
Constant RLANY_GET_X 1;
|
|
Constant RLANY_GET_Y 2;
|
|
Constant RLANY_CAN_GET_X 3;
|
|
Constant RLANY_CAN_GET_Y 4;
|
|
|
|
! RELS_LIST mode selection constant
|
|
Constant RLIST_ALL_X 1;
|
|
Constant RLIST_ALL_Y 2;
|
|
Constant RLIST_ALL_PAIRS 3;
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
Constant RRP_MIN_SIZE 8; ! minimum number of entries (DO NOT CHANGE)
|
|
Constant RRP_PERTURB_SHIFT 5; ! affects the probe sequence
|
|
Constant RRP_RESIZE_SMALL 4; ! resize factor for small tables
|
|
Constant RRP_RESIZE_LARGE 2; ! resize factor for large tables
|
|
Constant RRP_LARGE_IS 256; ! how many entries make a table "large"?
|
|
Constant RRP_CROWDED_IS 2; ! when filled entries outnumber unfilled by _ to 1
|
|
|
|
@p Abstract Relations.
|
|
As the following shows, we can abstractly use a relation -- that is, we can
|
|
use a relation whose identity we know little about -- by calling its handler
|
|
routine |R| in the form |R(rel, task, X, Y)|.
|
|
|
|
The task should be one of: |RELS_TEST|, |RELS_ASSERT_TRUE|, |RELS_ASSERT_FALSE|,
|
|
|RELS_SHOW|, |RELS_ROUTE_FIND|, |RELS_ROUTE_FIND_COUNT|, |RELS_COPY|,
|
|
|RELS_DESTROY|, |RELS_LOOKUP_ANY|, |RELS_LOOKUP_ALL_X|, |RELS_LOOKUP_ALL_Y|,
|
|
|RELS_LIST|, or |RELS_EMPTY|.
|
|
|
|
|RELS_SHOW| produces output for the SHOWME testing command.
|
|
|RELS_ROUTE_FIND| finds the next step in a route from |X| to |Y|, and
|
|
|RELS_ROUTE_FIND_COUNT| counts the shortest number of steps or returns $-1$
|
|
if no route exists. |RELS_COPY| makes a deep copy of the relation by
|
|
replacing all block values with duplicates, and |RELS_DESTROY| frees all
|
|
block values. |RELS_LOOKUP_ANY| finds any one of the |X| values related to
|
|
a given |Y|, or vice versa, or checks whether such an |X| or |Y| value
|
|
exists. |RELS_LOOKUP_ALL_X| and |RELS_LOOKUP_ALL_Y| produce a list of all
|
|
the |X| values related to a given |Y|, or vice versa. |RELS_LIST| produces
|
|
a list of all |X| values for which a corresponding |Y| exists, or vice
|
|
versa, or a list of all |(X,Y)| pairs for which |X| is related to |Y|.
|
|
|RELS_EMPTY| either makes the relation empty (if |X| is 1) or non-empty (if
|
|
|X| is 0) or makes no change (if |X| is negative), and in any case returns
|
|
true or false indicating whether the relation is now empty.
|
|
|
|
Because not every relation supports all of these operations, the
|
|
"permissions" word in the block is always a bitmap which is a sum of those
|
|
operations it does offer.
|
|
|
|
At present, these permissions are not checked as rigorously as they should be
|
|
(they're correctly set, but not much monitored).
|
|
|
|
@c
|
|
[ RelationTest relation task X Y handler rv;
|
|
handler = RlnGetF(relation, RR_HANDLER);
|
|
return handler(relation, task, X, Y);
|
|
];
|
|
|
|
[ RlnGetF rel fld i;
|
|
rel = BlkValueGetLongBlock(rel);
|
|
return rel-->fld;
|
|
];
|
|
|
|
[ RlnSetF rel fld v;
|
|
rel = BlkValueGetLongBlock(rel);
|
|
rel-->fld = v;
|
|
];
|
|
|
|
@p 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|.
|
|
|
|
@c
|
|
[ EmptyRelationHandler relation task X Y;
|
|
if (task == RELS_EMPTY) rtrue;
|
|
rfalse;
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ RELATION_TY_Create kov from sb rel i skov handler;
|
|
rel = FlexAllocate((RRV_DATA_BASE + 3*RRP_MIN_SIZE)*WORDSIZE,
|
|
RELATION_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
|
|
if ((from == 0) && (kov ~= 0)) from = DefaultValueFinder(kov);
|
|
if (from) {
|
|
for (i=0: i<RRV_DATA_BASE: i++) BlkValueWrite(rel, i, BlkValueRead(from, i), true);
|
|
if (BlkValueRead(from, RRV_HANDLER) == EmptyRelationHandler) {
|
|
handler = ChooseRelationHandler(BlkValueRead(rel, RRV_KIND, true));
|
|
BlkValueWrite(rel, RRV_NAME, "anonymous relation", true);
|
|
BlkValueWrite(rel, RRV_PERMISSIONS,
|
|
RELS_TEST+RELS_ASSERT_TRUE+RELS_ASSERT_FALSE+RELS_SHOW, true);
|
|
BlkValueWrite(rel, RRV_HANDLER, handler, true);
|
|
BlkValueWrite(rel, RRV_STORAGE, RRP_MIN_SIZE-1, true);
|
|
BlkValueWrite(rel, RRV_DESCRIPTION, "an anonymous relation", true);
|
|
BlkValueWrite(rel, RRV_USED, 0, true);
|
|
BlkValueWrite(rel, RRV_FILLED, 0, true);
|
|
}
|
|
} else {
|
|
handler = ChooseRelationHandler(kov);
|
|
BlkValueWrite(rel, RRV_NAME, "anonymous relation", true);
|
|
BlkValueWrite(rel, RRV_PERMISSIONS,
|
|
RELS_TEST+RELS_ASSERT_TRUE+RELS_ASSERT_FALSE+RELS_SHOW, true);
|
|
BlkValueWrite(rel, RRV_STORAGE, RRP_MIN_SIZE-1, true);
|
|
BlkValueWrite(rel, RRV_KIND, kov, true);
|
|
BlkValueWrite(rel, RRV_HANDLER, handler, true);
|
|
BlkValueWrite(rel, RRV_DESCRIPTION, "an anonymous relation", true);
|
|
BlkValueWrite(rel, RRV_USED, 0, true);
|
|
BlkValueWrite(rel, RRV_FILLED, 0, true);
|
|
}
|
|
|
|
return BlkValueCreateSB1(sb, rel);
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ RELATION_TY_Destroy rel handler;
|
|
handler = BlkValueRead(rel, RRV_HANDLER);
|
|
handler(rel, RELS_DESTROY);
|
|
];
|
|
|
|
@p Copying.
|
|
Same as destruction: invoke the handler using a special value to tell it to perform
|
|
deep copying.
|
|
|
|
@c
|
|
[ RELATION_TY_Copy lto lfrom handler;
|
|
handler = BlkValueRead(lto, RRV_HANDLER);
|
|
handler(lto, RELS_COPY);
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ RELATION_TY_Compare rleft rright ind1 ind2;
|
|
ind1 = BlkValueRead(rleft, RRV_HANDLER);
|
|
ind2 = BlkValueRead(rright, RRV_HANDLER);
|
|
if (ind1 ~= ind2) return ind1 - ind2;
|
|
if (IsMutableRelationHandler(ind1) == false) return 0;
|
|
return rleft - rright;
|
|
];
|
|
|
|
[ RELATION_TY_Distinguish rleft rright;
|
|
if (RELATION_TY_Compare(rleft, rright) == 0) rfalse;
|
|
rtrue;
|
|
];
|
|
|
|
@p Printing.
|
|
|
|
@c
|
|
[ RELATION_TY_Say rel;
|
|
if (rel == 0) print "(null relation)"; ! shouldn't happen
|
|
else print (string) RlnGetF(rel, RR_NAME);
|
|
];
|
|
|
|
@p Naming.
|
|
|
|
@c
|
|
[ RELATION_TY_Name rel txt;
|
|
if (rel) {
|
|
BlkValueWrite(rel, RRV_NAME, txt);
|
|
BlkValueWrite(rel, RRV_DESCRIPTION, txt);
|
|
}
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ ChooseRelationHandler kov sym;
|
|
if (KOVIsBlockValue(KindBaseTerm(kov, 0))) {
|
|
if (sym) return SymHashListRelationHandler;
|
|
return HashListRelationHandler;
|
|
}
|
|
if (sym) return SymDoubleHashSetRelationHandler;
|
|
return DoubleHashSetRelationHandler;
|
|
];
|
|
|
|
[ IsMutableRelationHandler h;
|
|
if (h == SymHashListRelationHandler or HashListRelationHandler or
|
|
SymDoubleHashSetRelationHandler or DoubleHashSetRelationHandler) rtrue;
|
|
rfalse;
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ RELATION_TY_SetValency rel val kov filled cur handler ext;
|
|
filled = BlkValueRead(rel, RRV_FILLED);
|
|
if (filled) { RunTimeProblem(RTP_RELATIONCHANGEIMPOSSIBLE); rfalse; }
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
if (val == RRVAL_EQUIV or RRVAL_SYM_V_TO_V or RRVAL_SYM_O_TO_O) {
|
|
if (KindBaseTerm(kov, 0) ~= KindBaseTerm(kov, 1)) {
|
|
RunTimeProblem(RTP_RELATIONCHANGEIMPOSSIBLE); rfalse;
|
|
}
|
|
}
|
|
cur = BlkValueRead(rel, RRV_HANDLER);
|
|
switch (val) {
|
|
RRVAL_V_TO_V: handler = ChooseRelationHandler(kov, false);
|
|
RRVAL_V_TO_O: handler = HashTableRelationHandler;
|
|
RRVAL_O_TO_V: handler = ReversedHashTableRelationHandler;
|
|
RRVAL_O_TO_O: handler = TwoInOneHashTableRelationHandler;
|
|
RRVAL_EQUIV: handler = EquivHashTableRelationHandler;
|
|
RRVAL_SYM_V_TO_V: handler = ChooseRelationHandler(kov, true);
|
|
RRVAL_SYM_O_TO_O: handler = Sym2in1HashTableRelationHandler;
|
|
default: RunTimeProblem(RTP_RELATIONCHANGEIMPOSSIBLE); rfalse;
|
|
}
|
|
if (cur == handler) rtrue;
|
|
! adjust size when going to or from 2-in-1
|
|
if (cur == TwoInOneHashTableRelationHandler) {
|
|
ext = BlkValueRead(rel, RRV_STORAGE) + 1;
|
|
BlkValueSetLBCapacity(rel, RRV_DATA_BASE + 3*ext);
|
|
} else if (handler == TwoInOneHashTableRelationHandler) {
|
|
ext = BlkValueRead(rel, RRV_STORAGE) + 1;
|
|
BlkValueSetLBCapacity(rel, RRV_DATA_BASE + 4*ext);
|
|
}
|
|
BlkValueWrite(rel, RRV_HANDLER, handler);
|
|
];
|
|
|
|
[ RELATION_TY_GetValency rel handler;
|
|
return BlkValueRead(rel, RRV_PERMISSIONS) & VALENCY_MASK;
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ DoubleHashSetRelationHandler rel task X Y sym kov kx ky at tmp v;
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
if (task == RELS_SET_VALENCY) {
|
|
return RELATION_TY_SetValency(rel, X);
|
|
} else if (task == RELS_DESTROY) {
|
|
! clear
|
|
kx = KOVIsBlockValue(kx); ky = KOVIsBlockValue(ky);
|
|
if (~~(kx || ky)) return;
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (tmp & RRF_USED) {
|
|
if (kx) BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1));
|
|
if (ky) BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2));
|
|
}
|
|
at--;
|
|
}
|
|
return;
|
|
} else if (task == RELS_COPY) {
|
|
X = KOVIsBlockValue(kx); Y = KOVIsBlockValue(ky);
|
|
if (~~(X || Y)) return;
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (tmp & RRF_USED) {
|
|
if (X) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
tmp = BlkValueCopy(BlkValueCreate(kx), tmp);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, tmp);
|
|
}
|
|
if (Y) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
tmp = BlkValueCopy(BlkValueCreate(ky), tmp);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp);
|
|
}
|
|
}
|
|
at--;
|
|
}
|
|
return;
|
|
} else if (task == RELS_SHOW) {
|
|
print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^";
|
|
if (sym) {
|
|
kov = KOVComparisonFunction(kx);
|
|
if (~~kov) kov = UnsignedCompare;
|
|
}
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (tmp & RRF_USED) {
|
|
X = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
Y = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
if (sym && (kov(X, Y) > 0)) continue;
|
|
print " ";
|
|
PrintKindValuePair(kx, X);
|
|
if (sym) print " <=> "; else print " >=> ";
|
|
PrintKindValuePair(ky, Y);
|
|
print "^";
|
|
}
|
|
}
|
|
return;
|
|
} else if (task == RELS_EMPTY) {
|
|
if (BlkValueRead(rel, RRV_USED) == 0) rtrue;
|
|
if (X == 1) {
|
|
DoubleHashSetRelationHandler(rel, RELS_DESTROY);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
BlkValueWrite(rel, tmp, 0);
|
|
BlkValueWrite(rel, tmp + 1, 0);
|
|
BlkValueWrite(rel, tmp + 2, 0);
|
|
}
|
|
BlkValueWrite(rel, RRV_USED, 0);
|
|
BlkValueWrite(rel, RRV_FILLED, 0);
|
|
rtrue;
|
|
}
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ANY) {
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_USED) {
|
|
if (Y == RLANY_GET_X or RLANY_CAN_GET_X) {
|
|
v = BlkValueRead(rel, tmp + 2);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(v, X) ~= 0) continue;
|
|
} else {
|
|
if (v ~= X) continue;
|
|
}
|
|
if (Y == RLANY_CAN_GET_X) rtrue;
|
|
return BlkValueRead(rel, tmp + 1);
|
|
} else {
|
|
v = BlkValueRead(rel, tmp + 1);
|
|
if (KOVIsBlockValue(kx)) {
|
|
if (BlkValueCompare(v, X) ~= 0) continue;
|
|
} else {
|
|
if (v ~= X) continue;
|
|
}
|
|
if (Y == RLANY_CAN_GET_Y) rtrue;
|
|
return BlkValueRead(rel, tmp + 2);
|
|
}
|
|
}
|
|
}
|
|
if (Y == RLANY_GET_X or RLANY_GET_Y)
|
|
print "*** Lookup failed: value not found ***^";
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ALL_X) {
|
|
if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(Y, 0);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_USED) {
|
|
v = BlkValueRead(rel, tmp + 2);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(v, X) ~= 0) continue;
|
|
} else {
|
|
if (v ~= X) continue;
|
|
}
|
|
LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 1));
|
|
}
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LOOKUP_ALL_Y) {
|
|
if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(Y, 0);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_USED) {
|
|
v = BlkValueRead(rel, tmp + 1);
|
|
if (KOVIsBlockValue(kx)) {
|
|
if (BlkValueCompare(v, X) ~= 0) continue;
|
|
} else {
|
|
if (v ~= X) continue;
|
|
}
|
|
LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 2));
|
|
}
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LIST) {
|
|
if (X == 0 || BlkValueWeakKind(X) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(X, 0);
|
|
switch (Y) {
|
|
RLIST_ALL_X, RLIST_ALL_Y:
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_USED) {
|
|
tmp++;
|
|
if (Y == RLIST_ALL_Y) tmp++;
|
|
v = BlkValueRead(rel, tmp);
|
|
LIST_OF_TY_InsertItem(X, v, false, 0, true);
|
|
}
|
|
}
|
|
return X;
|
|
RLIST_ALL_PAIRS:
|
|
! LIST_OF_TY_InsertItem will make a deep copy of the item,
|
|
! so we can reuse a single combination value here
|
|
|
|
Y = BlkValueCreate(kov);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_USED) {
|
|
v = BlkValueRead(rel, tmp + 1);
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE, v);
|
|
v = BlkValueRead(rel, tmp + 2);
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, v);
|
|
LIST_OF_TY_InsertItem(X, Y);
|
|
}
|
|
}
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE, 0);
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, 0);
|
|
BlkValueFree(Y);
|
|
return X;
|
|
}
|
|
rfalse;
|
|
}
|
|
at = DoubleHashSetLookUp(rel, kx, ky, X, Y);
|
|
switch(task) {
|
|
RELS_TEST:
|
|
if (at >= 0) rtrue;
|
|
rfalse;
|
|
RELS_ASSERT_TRUE:
|
|
if (at >= 0) rtrue;
|
|
at = ~at;
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1);
|
|
if (BlkValueRead(rel, RRV_DATA_BASE + 3*at) == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
|
|
if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); }
|
|
if (KOVIsBlockValue(ky)) { Y = BlkValueCopy(BlkValueCreate(ky), Y); }
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y);
|
|
DoubleHashSetCheckResize(rel);
|
|
rtrue;
|
|
RELS_ASSERT_FALSE:
|
|
if (at < 0) rtrue;
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1);
|
|
if (KOVIsBlockValue(kx))
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1));
|
|
if (KOVIsBlockValue(ky))
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2));
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_DELETED);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, 0);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, 0);
|
|
rtrue;
|
|
}
|
|
];
|
|
|
|
[ DoubleHashSetLookUp rel kx ky X Y hashv i free mask perturb flags;
|
|
! calculate a hash value for the pair
|
|
hashv = GetHashValue(kx, x) + GetHashValue(ky, y);
|
|
! look in the first expected slot
|
|
mask = BlkValueRead(rel, RRV_STORAGE);
|
|
i = hashv & mask;
|
|
flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
|
|
if (flags == 0) return ~i;
|
|
if (DoubleHashSetEntryMatches(rel, i, kx, ky, X, Y)) return i;
|
|
! not here, keep looking in sequence
|
|
free = -1;
|
|
if (flags & RRF_DELETED) free = i;
|
|
perturb = hashv;
|
|
hashv = i;
|
|
for (::) {
|
|
hashv = hashv*5 + perturb + 1;
|
|
i = hashv & mask;
|
|
flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
|
|
if (flags == 0) {
|
|
if (free >= 0) return ~free;
|
|
return ~i;
|
|
}
|
|
if (DoubleHashSetEntryMatches(rel, i, kx, ky, X, Y))
|
|
return i;
|
|
if ((free < 0) && (flags & RRF_DELETED)) free = i;
|
|
#ifdef TARGET_ZCODE;
|
|
@log_shift perturb (-RRP_PERTURB_SHIFT) -> perturb;
|
|
#ifnot;
|
|
@ushiftr perturb RRP_PERTURB_SHIFT perturb;
|
|
#endif;
|
|
}
|
|
];
|
|
|
|
[ DoubleHashSetCheckResize rel filled ext newext temp i at kov kx ky F X Y;
|
|
filled = BlkValueRead(rel, RRV_FILLED);
|
|
ext = BlkValueRead(rel, RRV_STORAGE) + 1;
|
|
if (filled >= (ext - filled) * RRP_CROWDED_IS) {
|
|
! copy entries to temporary space
|
|
temp = FlexAllocate(ext * (3*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
|
|
for (i=0: i<ext*3: i++)
|
|
BlkValueWrite(temp, i, BlkValueRead(rel, RRV_DATA_BASE+i), true);
|
|
! resize and clear our data
|
|
if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE;
|
|
else newext = ext * RRP_RESIZE_SMALL;
|
|
BlkValueSetLBCapacity(rel, RRV_DATA_BASE + newext*3);
|
|
BlkValueWrite(rel, RRV_STORAGE, newext - 1);
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_USED));
|
|
for (i=0: i<newext*3: i++)
|
|
BlkValueWrite(rel, RRV_DATA_BASE+i, 0);
|
|
! copy entries back from temporary space
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
for (i=0: i<ext: i++) {
|
|
F = BlkValueRead(temp, 3*i, true);
|
|
if (F == 0 || (F & RRF_DELETED)) continue;
|
|
X = BlkValueRead(temp, 3*i + 1, true);
|
|
Y = BlkValueRead(temp, 3*i + 2, true);
|
|
at = DoubleHashSetLookUp(rel, kx, ky, X, Y);
|
|
if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; }
|
|
at = ~at;
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, F);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y);
|
|
}
|
|
! done with temporary space
|
|
FlexFree(temp);
|
|
}
|
|
];
|
|
|
|
[ DoubleHashSetEntryMatches rel at kx ky X Y cx cy;
|
|
cx = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
if (KOVIsBlockValue(kx)) {
|
|
if (BlkValueCompare(cx, X) ~= 0) rfalse;
|
|
} else {
|
|
if (cx ~= X) rfalse;
|
|
}
|
|
cy = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(cy, Y) ~= 0) rfalse;
|
|
} else {
|
|
if (cy ~= Y) rfalse;
|
|
}
|
|
rtrue;
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ HashListRelationHandler rel task X Y sym kov kx ky;
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 1);
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ HashTableRelationHandler rel task X Y kov kx ky;
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 0);
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ ReversedHashTableRelationHandler rel task X Y kov kx ky swap;
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
switch (task) {
|
|
RELS_SET_VALENCY:
|
|
return RELATION_TY_SetValency(rel, X);
|
|
RELS_TEST, RELS_ASSERT_TRUE, RELS_ASSERT_FALSE:
|
|
return HashCoreRelationHandler(rel, task, ky, kx, Y, X, 0);
|
|
RELS_LOOKUP_ANY:
|
|
switch (Y) {
|
|
RLANY_GET_X: Y = RLANY_GET_Y;
|
|
RLANY_GET_Y: Y = RLANY_GET_X;
|
|
RLANY_CAN_GET_X: Y = RLANY_CAN_GET_Y;
|
|
RLANY_CAN_GET_Y: Y = RLANY_CAN_GET_X;
|
|
}
|
|
RELS_LOOKUP_ALL_X:
|
|
task = RELS_LOOKUP_ALL_Y;
|
|
RELS_LOOKUP_ALL_Y:
|
|
task = RELS_LOOKUP_ALL_X;
|
|
RELS_SHOW:
|
|
swap=X; X=Y; Y=swap;
|
|
swap=kx; kx=ky; ky=swap;
|
|
RELS_LIST:
|
|
switch (Y) {
|
|
RLIST_ALL_X: Y = RLIST_ALL_Y;
|
|
RLIST_ALL_Y: Y = RLIST_ALL_X;
|
|
}
|
|
}
|
|
return HashCoreRelationHandler(rel, task, kx, ky, X, Y, 0);
|
|
];
|
|
|
|
@p 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.)
|
|
|
|
@c
|
|
[ SymDoubleHashSetRelationHandler rel task X Y;
|
|
if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE)
|
|
DoubleHashSetRelationHandler(rel, task, Y, X);
|
|
return DoubleHashSetRelationHandler(rel, task, X, Y, 1);
|
|
];
|
|
|
|
[ SymHashListRelationHandler rel task X Y;
|
|
if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE)
|
|
HashListRelationHandler(rel, task, Y, X);
|
|
return HashListRelationHandler(rel, task, X, Y);
|
|
];
|
|
|
|
[ Sym2in1HashTableRelationHandler rel task X Y;
|
|
if (task == RELS_ASSERT_TRUE or RELS_ASSERT_FALSE)
|
|
TwoInOneHashTableRelationHandler(rel, task, Y, X);
|
|
return TwoInOneHashTableRelationHandler(rel, task, X, Y, 1);
|
|
];
|
|
|
|
@p 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)$.
|
|
|
|
@c
|
|
[ HashCoreRelationHandler rel task kx ky X Y mult sym rev at tmp fl;
|
|
if (task == RELS_SET_VALENCY) {
|
|
return RELATION_TY_SetValency(rel, X);
|
|
} else if (task == RELS_DESTROY) {
|
|
! clear
|
|
kx = KOVIsBlockValue(kx); ky = KOVIsBlockValue(ky);
|
|
if (~~(kx || ky)) return;
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl & RRF_USED) {
|
|
if (kx) BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1));
|
|
if (ky || ~~(fl & RRF_SINGLE))
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2));
|
|
}
|
|
at--;
|
|
}
|
|
return;
|
|
} else if (task == RELS_COPY) {
|
|
X = KOVIsBlockValue(kx); Y = KOVIsBlockValue(ky);
|
|
if (~~(X || Y)) return;
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl & RRF_USED) {
|
|
if (X) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
tmp = BlkValueCopy(BlkValueCreate(kx), tmp);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, tmp);
|
|
}
|
|
if (Y || ~~(fl & RRF_SINGLE)) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
tmp = BlkValueCopy(BlkValueCreate(BlkValueWeakKind(tmp)), tmp);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp);
|
|
}
|
|
}
|
|
at--;
|
|
}
|
|
return;
|
|
} else if (task == RELS_SHOW) {
|
|
print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^";
|
|
! Z-machine doesn't have the room to let us pass sym/rev as parameters
|
|
switch (RELATION_TY_GetValency(rel)) {
|
|
RRVAL_SYM_V_TO_V:
|
|
sym = 1;
|
|
tmp = KOVComparisonFunction(kx);
|
|
if (~~tmp) tmp = UnsignedCompare;
|
|
RRVAL_O_TO_V:
|
|
rev = 1;
|
|
}
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl & RRF_USED) {
|
|
X = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
Y = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
if (fl & RRF_SINGLE) {
|
|
if (sym && tmp(X, Y) > 0) continue;
|
|
print " ";
|
|
if (rev) PrintKindValuePair(ky, Y);
|
|
else PrintKindValuePair(kx, X);
|
|
if (sym) print " <=> "; else print " >=> ";
|
|
if (rev) PrintKindValuePair(kx, X);
|
|
else PrintKindValuePair(ky, Y);
|
|
print "^";
|
|
} else {
|
|
for (mult=1: mult<=LIST_OF_TY_GetLength(Y): mult++) {
|
|
fl = LIST_OF_TY_GetItem(Y, mult);
|
|
if (sym && tmp(X, fl) > 0) continue;
|
|
print " ";
|
|
if (rev) PrintKindValuePair(ky, fl);
|
|
else PrintKindValuePair(kx, X);
|
|
if (sym) print " <=> "; else print " >=> ";
|
|
if (rev) PrintKindValuePair(kx, X);
|
|
else PrintKindValuePair(ky, fl);
|
|
print "^";
|
|
}
|
|
}
|
|
}
|
|
}
|
|
return;
|
|
} else if (task == RELS_EMPTY) {
|
|
if (BlkValueRead(rel, RRV_USED) == 0) rtrue;
|
|
if (X == 1) {
|
|
HashCoreRelationHandler(rel, RELS_DESTROY);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
BlkValueWrite(rel, tmp, 0);
|
|
BlkValueWrite(rel, tmp + 1, 0);
|
|
BlkValueWrite(rel, tmp + 2, 0);
|
|
}
|
|
BlkValueWrite(rel, RRV_USED, 0);
|
|
BlkValueWrite(rel, RRV_FILLED, 0);
|
|
rtrue;
|
|
}
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ANY) {
|
|
if (Y == RLANY_GET_Y or RLANY_CAN_GET_Y) {
|
|
at = HashCoreLookUp(rel, kx, X);
|
|
if (at >= 0) {
|
|
if (Y == RLANY_CAN_GET_Y) rtrue;
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
tmp = BlkValueRead(rel, tmp + 2);
|
|
if (fl & RRF_SINGLE) return tmp;
|
|
return LIST_OF_TY_GetItem(tmp, 1);
|
|
}
|
|
} else {
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if (fl & RRF_USED) {
|
|
sym = BlkValueRead(rel, tmp + 2);
|
|
if (fl & RRF_SINGLE) {
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(X, sym) ~= 0) continue;
|
|
} else {
|
|
if (X ~= sym) continue;
|
|
}
|
|
} else {
|
|
if (LIST_OF_TY_FindItem(sym, X) == 0) continue;
|
|
}
|
|
if (Y == RLANY_CAN_GET_X) rtrue;
|
|
return BlkValueRead(rel, tmp + 1);
|
|
}
|
|
}
|
|
}
|
|
if (Y == RLANY_GET_X or RLANY_GET_Y)
|
|
print "*** Lookup failed: value not found ***^";
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ALL_X) {
|
|
if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(Y, 0);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if (fl & RRF_USED) {
|
|
sym = BlkValueRead(rel, tmp + 2);
|
|
if (fl & RRF_SINGLE) {
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(X, sym) ~= 0) continue;
|
|
} else {
|
|
if (X ~= sym) continue;
|
|
}
|
|
} else {
|
|
if (LIST_OF_TY_FindItem(sym, X) == 0) continue;
|
|
}
|
|
LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 1));
|
|
}
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LOOKUP_ALL_Y) {
|
|
if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(Y, 0);
|
|
at = HashCoreLookUp(rel, kx, X);
|
|
if (at >= 0) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
tmp = BlkValueRead(rel, tmp + 2);
|
|
if (fl & RRF_SINGLE)
|
|
LIST_OF_TY_InsertItem(Y, tmp);
|
|
else
|
|
LIST_OF_TY_AppendList(Y, tmp);
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LIST) {
|
|
if (BlkValueWeakKind(X) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(X, 0);
|
|
switch (Y) {
|
|
RLIST_ALL_X:
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if (fl & RRF_USED)
|
|
LIST_OF_TY_InsertItem(X, BlkValueRead(rel, tmp + 1));
|
|
}
|
|
return X;
|
|
RLIST_ALL_Y:
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if (fl & RRF_USED) {
|
|
tmp = BlkValueRead(rel, tmp + 2);
|
|
if (fl & RRF_SINGLE)
|
|
LIST_OF_TY_InsertItem(X, tmp, false, 0, true);
|
|
else
|
|
LIST_OF_TY_AppendList(X, tmp, false, 0, true);
|
|
}
|
|
}
|
|
return X;
|
|
RLIST_ALL_PAIRS:
|
|
if (RELATION_TY_GetValency(rel) == RRVAL_O_TO_V) rev = 1;
|
|
! LIST_OF_TY_InsertItem will make a deep copy of the item,
|
|
! so we can reuse a single combination value here
|
|
Y = BlkValueCreate(COMBINATION_TY, tmp);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if (fl & RRF_USED) {
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + rev, BlkValueRead(rel, tmp + 1));
|
|
tmp = BlkValueRead(rel, tmp + 2);
|
|
if (fl & RRF_SINGLE) {
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1 - rev, tmp);
|
|
LIST_OF_TY_InsertItem(X, Y);
|
|
} else {
|
|
for (mult = LIST_OF_TY_GetLength(tmp): mult > 0: mult--) {
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1 - rev,
|
|
LIST_OF_TY_GetItem(tmp, mult));
|
|
LIST_OF_TY_InsertItem(X, Y);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE, 0);
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, 0);
|
|
BlkValueFree(Y);
|
|
return X;
|
|
}
|
|
rfalse;
|
|
}
|
|
at = HashCoreLookUp(rel, kx, X);
|
|
switch(task) {
|
|
RELS_TEST:
|
|
if (at < 0) rfalse;
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
if (fl & RRF_SINGLE) {
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(tmp, Y) == 0) rtrue;
|
|
} else {
|
|
if (tmp == Y) rtrue;
|
|
}
|
|
rfalse;
|
|
} else {
|
|
return LIST_OF_TY_FindItem(tmp, Y);
|
|
}
|
|
RELS_ASSERT_TRUE:
|
|
if (at < 0) {
|
|
! no entry exists for this key, just add one
|
|
at = ~at;
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1);
|
|
if (BlkValueRead(rel, RRV_DATA_BASE + 3*at) == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
|
|
if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); }
|
|
if (KOVIsBlockValue(ky)) { Y = BlkValueCopy(BlkValueCreate(ky), Y); }
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y);
|
|
HashCoreCheckResize(rel);
|
|
break;
|
|
}
|
|
! an entry exists: could be a list or a single value
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); ! flags
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); ! value or list
|
|
if (fl & RRF_SINGLE) {
|
|
! if Y is the same as the stored key, we have nothing to do
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(tmp, Y) == 0) rtrue;
|
|
} else {
|
|
if (tmp == Y) rtrue;
|
|
}
|
|
! it's different: either replace it or expand into a list,
|
|
! depending on the value of mult
|
|
if (mult) {
|
|
fl = BlkValueCreate(LIST_OF_TY); ! new list
|
|
BlkValueWrite(fl, LIST_ITEM_KOV_F, ky);
|
|
LIST_OF_TY_SetLength(fl, 2);
|
|
BlkValueWrite(fl, LIST_ITEM_BASE, tmp); ! do not copy
|
|
LIST_OF_TY_PutItem(fl, 2, Y); ! copy if needed
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, fl);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED);
|
|
} else {
|
|
if (KOVIsBlockValue(ky)) {
|
|
BlkValueFree(tmp);
|
|
Y = BlkValueCopy(BlkValueCreate(ky), Y);
|
|
}
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y);
|
|
}
|
|
} else {
|
|
! if Y is present already, do nothing. otherwise add it.
|
|
LIST_OF_TY_InsertItem(tmp, Y, 0, 0, 1);
|
|
}
|
|
rtrue;
|
|
RELS_ASSERT_FALSE:
|
|
if (at < 0) rtrue;
|
|
! an entry exists: could be a list or a single value
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at); ! flags
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); ! value or list
|
|
if (fl & RRF_SINGLE) {
|
|
! if the stored key isn't Y, we have nothing to do
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(tmp, Y) ~= 0) rtrue;
|
|
} else {
|
|
if (tmp ~= Y) rtrue;
|
|
}
|
|
! delete the entry
|
|
if (KOVIsBlockValue(ky))
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2));
|
|
.DeleteEntryIgnoringY;
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1);
|
|
if (KOVIsBlockValue(kx))
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1));
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_DELETED);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, 0);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, 0);
|
|
} else {
|
|
! remove Y from the list if present
|
|
LIST_OF_TY_RemoveValue(tmp, Y, 1);
|
|
! if the list is now empty, delete the whole entry
|
|
if (LIST_OF_TY_GetLength(tmp) == 0) {
|
|
BlkValueFree(tmp);
|
|
jump DeleteEntryIgnoringY;
|
|
}
|
|
}
|
|
rtrue;
|
|
}
|
|
rtrue;
|
|
];
|
|
|
|
[ HashCoreLookUp rel kx X hashv i free mask perturb flags;
|
|
!print "[HCLU rel=", rel, " kx=", kx, " X=", X, ": ";
|
|
! calculate a hash value for the key
|
|
hashv = GetHashValue(kx, x);
|
|
! look in the first expected slot
|
|
mask = BlkValueRead(rel, RRV_STORAGE);
|
|
i = hashv & mask;
|
|
!print "hv=", hashv, ", trying ", i;
|
|
flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
|
|
if (flags == 0) {
|
|
!print " - not found]^";
|
|
return ~i;
|
|
}
|
|
if (HashCoreEntryMatches(rel, i, kx, X)) {
|
|
!print " - found]^";
|
|
return i;
|
|
}
|
|
! not here, keep looking in sequence
|
|
free = -1;
|
|
if (flags & RRF_DELETED) free = i;
|
|
perturb = hashv;
|
|
hashv = i;
|
|
for (::) {
|
|
hashv = hashv*5 + perturb + 1;
|
|
i = hashv & mask;
|
|
!print ", ", i;
|
|
flags = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
|
|
if (flags == 0) {
|
|
!print " - not found]^";
|
|
if (free >= 0) return ~free;
|
|
return ~i;
|
|
}
|
|
if (HashCoreEntryMatches(rel, i, kx, X)) {
|
|
!print " - found]^";
|
|
return i;
|
|
}
|
|
if ((free < 0) && (flags & RRF_DELETED)) free = i;
|
|
#ifdef TARGET_ZCODE;
|
|
@log_shift perturb (-RRP_PERTURB_SHIFT) -> perturb;
|
|
#ifnot;
|
|
@ushiftr perturb RRP_PERTURB_SHIFT perturb;
|
|
#endif;
|
|
}
|
|
];
|
|
|
|
[ HashCoreCheckResize rel filled ext newext temp i at kov kx F X Y;
|
|
filled = BlkValueRead(rel, RRV_FILLED);
|
|
ext = BlkValueRead(rel, RRV_STORAGE) + 1;
|
|
if (filled >= (ext - filled) * RRP_CROWDED_IS) {
|
|
! copy entries to temporary space
|
|
temp = FlexAllocate(ext * (3*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
|
|
for (i=0: i<ext*3: i++)
|
|
BlkValueWrite(temp, i, BlkValueRead(rel, RRV_DATA_BASE+i), true);
|
|
! resize and clear our data
|
|
if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE;
|
|
else newext = ext * RRP_RESIZE_SMALL;
|
|
BlkValueSetLBCapacity(rel, RRV_DATA_BASE + newext*3);
|
|
BlkValueWrite(rel, RRV_STORAGE, newext - 1);
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_USED));
|
|
for (i=0: i<newext*3: i++)
|
|
BlkValueWrite(rel, RRV_DATA_BASE+i, 0);
|
|
! copy entries back from temporary space
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0);
|
|
for (i=0: i<ext: i++) {
|
|
F = BlkValueRead(temp, 3*i, true);
|
|
if (F == 0 || (F & RRF_DELETED)) continue;
|
|
X = BlkValueRead(temp, 3*i + 1, true);
|
|
Y = BlkValueRead(temp, 3*i + 2, true);
|
|
at = HashCoreLookUp(rel, kx, X);
|
|
if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; }
|
|
at = ~at;
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, F);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, Y);
|
|
}
|
|
! done with temporary space
|
|
FlexFree(temp);
|
|
}
|
|
];
|
|
|
|
[ HashCoreEntryMatches rel at kx X cx cy;
|
|
cx = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
if (KOVIsBlockValue(kx)) {
|
|
if (BlkValueCompare(cx, X) ~= 0) rfalse;
|
|
} else {
|
|
if (cx ~= X) rfalse;
|
|
}
|
|
rtrue;
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ EquivHashTableRelationHandler rel task X Y kx at at2 tmp fl i ext;
|
|
kx = KindBaseTerm(BlkValueRead(rel, RRV_KIND), 0);
|
|
if (task == RELS_SET_VALENCY) {
|
|
return RELATION_TY_SetValency(rel, X);
|
|
} else if (task == RELS_DESTROY) {
|
|
! clear
|
|
if (KOVIsBlockValue(kx)) {
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl & RRF_USED) {
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1));
|
|
}
|
|
at--;
|
|
}
|
|
}
|
|
return;
|
|
} else if (task == RELS_COPY) {
|
|
if (KOVIsBlockValue(kx)) {
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl & RRF_USED) {
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1);
|
|
tmp = BlkValueCopy(BlkValueCreate(kx), tmp);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1);
|
|
}
|
|
at--;
|
|
}
|
|
}
|
|
return;
|
|
} else if (task == RELS_SHOW) {
|
|
print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^";
|
|
ext = BlkValueRead(rel, RRV_STORAGE);
|
|
! flag all items by negating their group numbers
|
|
for (at=0, X=RRV_DATA_BASE: at<=ext: at++, X=X+3)
|
|
if (BlkValueRead(rel, X) & RRF_USED)
|
|
BlkValueWrite(rel, X + 2, -(BlkValueRead(rel, X + 2)));
|
|
! display groups, unflagging them as we go
|
|
for (at=0, X=RRV_DATA_BASE, fl=0: at<=ext: at++, X=X+3, fl=0) {
|
|
if (BlkValueRead(rel, X) & RRF_USED) {
|
|
fl = BlkValueRead(rel, X + 2);
|
|
if (fl > 0) continue; ! already visited
|
|
BlkValueWrite(rel, X + 2, -fl); ! unflag it
|
|
! display the group starting with this member, but only
|
|
! if there are more members in the group
|
|
tmp = BlkValueRead(rel, X + 1);
|
|
i = 0;
|
|
for (at2=at+1, Y=RRV_DATA_BASE+3*at2: at2<=ext: at2++, Y=Y+3) {
|
|
if (BlkValueRead(rel, Y) & RRF_USED) {
|
|
if (BlkValueRead(rel, Y + 2) ~= fl) continue;
|
|
BlkValueWrite(rel, Y + 2, -fl);
|
|
if (~~i) {
|
|
! print the saved first member
|
|
print " { ";
|
|
PrintKindValuePair(kx, tmp);
|
|
i = 1;
|
|
}
|
|
print ", ";
|
|
PrintKindValuePair(kx, BlkValueRead(rel, Y + 1));
|
|
}
|
|
}
|
|
if (i) print " }^";
|
|
}
|
|
}
|
|
return;
|
|
} else if (task == RELS_EMPTY) {
|
|
! never empty since R(x,x) is always true
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ANY) {
|
|
! kind of a cheat, but it's faster than searching for a better value to return
|
|
if (Y == RLANY_CAN_GET_X or RLANY_CAN_GET_Y) rtrue;
|
|
return X;
|
|
} else if (task == RELS_LOOKUP_ALL_X or RELS_LOOKUP_ALL_Y) {
|
|
if (BlkValueWeakKind(Y) ~= LIST_OF_TY) rfalse;
|
|
LIST_OF_TY_SetLength(Y, 0);
|
|
BlkValueWrite(Y, LIST_ITEM_KOV_F, kx);
|
|
at = HashCoreLookUp(rel, kx, X);
|
|
if (at < 0) {
|
|
LIST_OF_TY_InsertItem(Y, X);
|
|
} else {
|
|
X = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 3*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if (fl & RRF_USED) {
|
|
if (BlkValueRead(rel, tmp + 2) ~= X) continue;
|
|
LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 1));
|
|
}
|
|
}
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LIST) {
|
|
print "*** Domains of equivalence relations cannot be listed ***^";
|
|
return X;
|
|
}
|
|
at = HashCoreLookUp(rel, kx, X);
|
|
at2 = HashCoreLookUp(rel, kx, Y);
|
|
switch(task) {
|
|
RELS_TEST:
|
|
if (at < 0) {
|
|
! X is a loner, but could still be true if X == Y
|
|
if (KOVIsBlockValue(kx)) {
|
|
if (BlkValueCompare(X, Y) == 0) rtrue;
|
|
} else {
|
|
if (X == Y) rtrue;
|
|
}
|
|
rfalse;
|
|
}
|
|
if (at2 < 0) rfalse;
|
|
if (at == at2) rtrue;
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
if (BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2) == tmp) rtrue;
|
|
rfalse;
|
|
RELS_ASSERT_TRUE:
|
|
! if X and Y are the same, we have nothing to do
|
|
if (KOVIsBlockValue(kx)) {
|
|
if (BlkValueCompare(X, Y) == 0) rtrue;
|
|
} else {
|
|
if (X == Y) rtrue;
|
|
}
|
|
if (at < 0) {
|
|
if (at2 < 0) {
|
|
! X and Y both missing: find a new group number and add both entries
|
|
tmp = 0; ! candidate group number
|
|
ext = BlkValueRead(rel, RRV_STORAGE);
|
|
for (i=0: i<=ext: i++) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*i);
|
|
if (fl & RRF_USED) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*i + 2);
|
|
if (fl > tmp) tmp = fl;
|
|
}
|
|
}
|
|
tmp++; ! new group number
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 2);
|
|
! add X entry
|
|
at = ~at;
|
|
if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); }
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp);
|
|
! add Y entry. at2 might change if X and Y have the same hash code.
|
|
at2 = ~(HashCoreLookUp(rel, kx, Y));
|
|
if (KOVIsBlockValue(kx)) { Y = BlkValueCopy(BlkValueCreate(kx), Y); }
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2);
|
|
if (fl == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at2, RRF_USED+RRF_SINGLE);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 1, Y);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 2, tmp);
|
|
jump CheckResize;
|
|
}
|
|
! X missing, Y present: add a new X entry
|
|
at = ~at;
|
|
if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); }
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1);
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at);
|
|
if (fl == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_USED+RRF_SINGLE);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, X);
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, tmp);
|
|
jump CheckResize;
|
|
}
|
|
if (at2 < 0) {
|
|
! X present, Y missing: add a new Y entry
|
|
at2 = ~at2;
|
|
if (KOVIsBlockValue(kx)) { Y = BlkValueCopy(BlkValueCreate(kx), Y); }
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1);
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2);
|
|
if (fl == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at2, RRF_USED+RRF_SINGLE);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 1, Y);
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at2 + 2, tmp);
|
|
jump CheckResize;
|
|
}
|
|
! X and Y both present: merge higher group into lower group
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2); ! higher group
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2); ! lower group
|
|
if (tmp < fl) { i = tmp; tmp = fl; fl = i; }
|
|
ext = BlkValueRead(rel, RRV_STORAGE);
|
|
for (at=0: at<=ext: at++) {
|
|
i = RRV_DATA_BASE + 3*at + 2;
|
|
if (BlkValueRead(rel, i) == tmp)
|
|
BlkValueWrite(rel, i, fl);
|
|
}
|
|
.CheckResize;
|
|
HashCoreCheckResize(rel);
|
|
rtrue;
|
|
RELS_ASSERT_FALSE:
|
|
! if X and Y are already in different groups, we have nothing to do
|
|
if (at < 0 || at2 < 0) rtrue;
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 3*at + 2);
|
|
if (BlkValueRead(rel, RRV_DATA_BASE + 3*at2 + 2) ~= tmp) rtrue;
|
|
! delete the entry for X
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1);
|
|
if (KOVIsBlockValue(kx))
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 3*at + 1));
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at, RRF_DELETED);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 1, 0);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 3*at + 2, 0);
|
|
rtrue;
|
|
}
|
|
];
|
|
|
|
@p 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.)
|
|
|
|
@c
|
|
[ TwoInOneHashTableRelationHandler rel task X Y sym kov kx ky at at2 tmp fl;
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
if (task == RELS_SET_VALENCY) {
|
|
return RELATION_TY_SetValency(rel, X);
|
|
} else if (task == RELS_DESTROY) {
|
|
! clear
|
|
kx = KOVIsBlockValue(kx); ky = KOVIsBlockValue(ky);
|
|
if (~~(kx || ky)) return;
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if (fl & RRF_USED)
|
|
if ((kx && (fl & RRF_ENTKEYX)) || (ky && (fl & RRF_ENTKEYY))) {
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1));
|
|
}
|
|
at--;
|
|
}
|
|
return;
|
|
} else if (task == RELS_COPY) {
|
|
X = KOVIsBlockValue(kx); Y = KOVIsBlockValue(ky);
|
|
if (~~(X || Y)) return;
|
|
at = BlkValueRead(rel, RRV_STORAGE);
|
|
while (at >= 0) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if (fl & RRF_USED) {
|
|
if ((X && (fl & RRF_ENTKEYX)) || (Y && (fl & RRF_ENTKEYY))) {
|
|
! copy the entry key
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1);
|
|
if (fl & RRF_ENTKEYX)
|
|
tmp = BlkValueCopy(BlkValueCreate(kx), tmp);
|
|
else
|
|
tmp = BlkValueCopy(BlkValueCreate(ky), tmp);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, tmp);
|
|
! update references in X/Y fields pointing here
|
|
if (fl & RRF_HASX) {
|
|
at2 = TwoInOneLookUp(rel, kx,
|
|
BlkValueRead(rel, RRV_DATA_BASE + 4*at + 2),
|
|
RRF_ENTKEYX);
|
|
if (at2 >= 0)
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 3, tmp);
|
|
}
|
|
if (fl & RRF_HASY) {
|
|
at2 = TwoInOneLookUp(rel, ky,
|
|
BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3),
|
|
RRF_ENTKEYY);
|
|
if (at2 >= 0)
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 2, tmp);
|
|
}
|
|
}
|
|
}
|
|
at--;
|
|
}
|
|
return;
|
|
} else if (task == RELS_SHOW) {
|
|
print (string) BlkValueRead(rel, RRV_DESCRIPTION), ":^";
|
|
if (sym) {
|
|
kov = KOVComparisonFunction(kx);
|
|
if (~~kov) kov = UnsignedCompare;
|
|
}
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if ((fl & (RRF_USED+RRF_ENTKEYX+RRF_HASY)) ==
|
|
(RRF_USED+RRF_ENTKEYX+RRF_HASY)) {
|
|
X = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1);
|
|
Y = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3);
|
|
if (sym && kov(X, Y) > 0) continue;
|
|
print " ";
|
|
PrintKindValuePair(kx, X);
|
|
if (sym) print " <=> "; else print " >=> ";
|
|
PrintKindValuePair(ky, Y);
|
|
print "^";
|
|
}
|
|
}
|
|
return;
|
|
} else if (task == RELS_EMPTY) {
|
|
if (BlkValueRead(rel, RRV_USED) == 0) rtrue;
|
|
if (X == 1) {
|
|
TwoInOneHashTableRelationHandler(rel, RELS_DESTROY);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
BlkValueWrite(rel, tmp, 0);
|
|
BlkValueWrite(rel, tmp + 1, 0);
|
|
BlkValueWrite(rel, tmp + 2, 0);
|
|
BlkValueWrite(rel, tmp + 3, 0);
|
|
}
|
|
BlkValueWrite(rel, RRV_USED, 0);
|
|
BlkValueWrite(rel, RRV_FILLED, 0);
|
|
rtrue;
|
|
}
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ANY) {
|
|
switch (Y) {
|
|
RLANY_GET_X, RLANY_CAN_GET_X:
|
|
at = TwoInOneLookUp(rel, ky, X, RRF_ENTKEYY);
|
|
if (at >= 0) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_HASX) {
|
|
if (Y == RLANY_CAN_GET_X) rtrue;
|
|
return BlkValueRead(rel, tmp + 2);
|
|
}
|
|
}
|
|
RLANY_GET_Y, RLANY_CAN_GET_Y:
|
|
at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX);
|
|
if (at >= 0) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_HASY) {
|
|
if (Y == RLANY_CAN_GET_Y) rtrue;
|
|
return BlkValueRead(rel, tmp + 3);
|
|
}
|
|
}
|
|
}
|
|
if (Y == RLANY_GET_X or RLANY_GET_Y)
|
|
print "*** Lookup failed: value not found ***^";
|
|
rfalse;
|
|
} else if (task == RELS_LOOKUP_ALL_X) {
|
|
at = TwoInOneLookUp(rel, ky, X, RRF_ENTKEYY);
|
|
if (at >= 0) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_HASX)
|
|
LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 2));
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LOOKUP_ALL_Y) {
|
|
at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX);
|
|
if (at >= 0) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
if (BlkValueRead(rel, tmp) & RRF_HASY)
|
|
LIST_OF_TY_InsertItem(Y, BlkValueRead(rel, tmp + 3));
|
|
}
|
|
return Y;
|
|
} else if (task == RELS_LIST) {
|
|
switch (Y) {
|
|
RLIST_ALL_X:
|
|
fl = RRF_USED+RRF_ENTKEYX+RRF_HASY;
|
|
jump ListEntryKeys;
|
|
RLIST_ALL_Y:
|
|
fl = RRF_USED+RRF_ENTKEYY+RRF_HASX;
|
|
.ListEntryKeys;
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
if ((BlkValueRead(rel, tmp) & fl) == fl)
|
|
LIST_OF_TY_InsertItem(X, BlkValueRead(rel, tmp + 1), false, 0, true);
|
|
}
|
|
RLIST_ALL_PAIRS:
|
|
tmp = BlkValueRead(X, LIST_ITEM_KOV_F);
|
|
if (KindAtomic(tmp) ~= COMBINATION_TY) rfalse;
|
|
! LIST_OF_TY_InsertItem will make a deep copy of the item,
|
|
! so we can reuse a single combination value here
|
|
Y = BlkValueCreate(tmp);
|
|
for (at = BlkValueRead(rel, RRV_STORAGE): at >= 0: at--) {
|
|
tmp = RRV_DATA_BASE + 4*at;
|
|
fl = BlkValueRead(rel, tmp);
|
|
if ((fl & (RRF_USED+RRF_ENTKEYX+RRF_HASY)) ==
|
|
(RRF_USED+RRF_ENTKEYX+RRF_HASY)) {
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE, BlkValueRead(rel, tmp + 1));
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, BlkValueRead(rel, tmp + 3));
|
|
LIST_OF_TY_InsertItem(X, Y);
|
|
}
|
|
}
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE, 0);
|
|
BlkValueWrite(Y, COMBINATION_ITEM_BASE + 1, 0);
|
|
BlkValueFree(Y);
|
|
return X;
|
|
}
|
|
return X;
|
|
}
|
|
at = TwoInOneLookUp(rel, kx, X, RRF_ENTKEYX);
|
|
switch(task) {
|
|
RELS_TEST:
|
|
if (at < 0) rfalse;
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if (~~(fl & RRF_HASY)) rfalse;
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(tmp, Y) == 0) rtrue;
|
|
} else {
|
|
if (tmp == Y) rtrue;
|
|
}
|
|
rfalse;
|
|
RELS_ASSERT_TRUE:
|
|
if (at < 0) {
|
|
! create a new forward entry
|
|
at = ~at;
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1);
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if (fl == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
fl = RRF_USED+RRF_HASY+RRF_ENTKEYX;
|
|
if (kx == ky || ~~(KOVIsBlockValue(kx) || KOVIsBlockValue(ky)))
|
|
fl = fl + RRF_ENTKEYY;
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at, fl);
|
|
if (KOVIsBlockValue(kx)) { X = BlkValueCopy(BlkValueCreate(kx), X); }
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 2, 0);
|
|
} else {
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if (fl & RRF_HASY) {
|
|
! if the Y we're inserting is already there, we're done
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(tmp, Y) == 0) rtrue;
|
|
} else {
|
|
if (tmp == Y) rtrue;
|
|
}
|
|
! it's different, so delete the reverse entry
|
|
at2 = TwoInOneLookUp(rel, ky, tmp, RRF_ENTKEYY);
|
|
if (at2 >= 0) TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY);
|
|
} else {
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at, fl + RRF_HASY);
|
|
}
|
|
! use the existing copy of X
|
|
X = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1);
|
|
}
|
|
! use the existing copy of Y if there is one
|
|
at2 = TwoInOneLookUp(rel, ky, Y, RRF_ENTKEYY);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (at2 >= 0)
|
|
Y = BlkValueRead(rel, RRV_DATA_BASE + 4*at2 + 1);
|
|
else
|
|
Y = BlkValueCopy(BlkValueCreate(ky), Y);
|
|
}
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 3, Y);
|
|
if (at2 >= 0) {
|
|
! delete existing reverse entry (and its own forward entry)
|
|
TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY, 1);
|
|
} else {
|
|
at2 = ~at2;
|
|
}
|
|
! create reverse entry
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) + 1);
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at2);
|
|
if (fl == 0)
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_FILLED) + 1);
|
|
fl = fl | (RRF_USED+RRF_HASX+RRF_ENTKEYY);
|
|
if (kx == ky || ~~(KOVIsBlockValue(kx) || KOVIsBlockValue(ky)))
|
|
fl = fl | RRF_ENTKEYX;
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at2, fl);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 1, Y);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at2 + 2, X);
|
|
TwoInOneCheckResize(rel);
|
|
rtrue;
|
|
RELS_ASSERT_FALSE:
|
|
! we only have work to do if the entry exists and has a Y which
|
|
! matches the Y we're deleting
|
|
if (at < 0) rtrue;
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if ((fl & RRF_HASY) == 0) rtrue;
|
|
tmp = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 3);
|
|
if (KOVIsBlockValue(ky)) {
|
|
if (BlkValueCompare(tmp, Y) ~= 0) rtrue;
|
|
} else {
|
|
if (tmp ~= Y) rtrue;
|
|
}
|
|
TwoInOneDelete(rel, at, kx, ky, RRF_ENTKEYX, 1);
|
|
rtrue;
|
|
}
|
|
];
|
|
|
|
[ TwoInOneDelete rel at kx ky ekflag both fl at2 E i;
|
|
!print "[2in1DEL at=", at, " (E=", BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1), ") ekflag=", ekflag, " both=", both, "]^";
|
|
fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
if (ekflag == RRF_ENTKEYX) {
|
|
if (fl & RRF_HASY) {
|
|
i = RRV_DATA_BASE + 4*at + 3;
|
|
if (both) E = BlkValueRead(rel, i);
|
|
BlkValueWrite(rel, i, 0);
|
|
! delete matching Y<-X entry if needed
|
|
if (both) {
|
|
at2 = TwoInOneLookUp(rel, ky, E, RRF_ENTKEYY);
|
|
if (at2 >= 0) TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYY);
|
|
if (at2 == at) fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
}
|
|
fl = fl & ~RRF_HASY;
|
|
}
|
|
} else {
|
|
if (fl & RRF_HASX) {
|
|
i = RRV_DATA_BASE + 4*at + 2;
|
|
if (both) E = BlkValueRead(rel, i);
|
|
BlkValueWrite(rel, i, 0);
|
|
! delete matching X->Y entry if needed
|
|
if (both) {
|
|
at2 = TwoInOneLookUp(rel, kx, E, RRF_ENTKEYX);
|
|
if (at2 >= 0) {
|
|
TwoInOneDelete(rel, at2, kx, ky, RRF_ENTKEYX);
|
|
if (at2 == at) fl = BlkValueRead(rel, RRV_DATA_BASE + 4*at);
|
|
}
|
|
}
|
|
fl = fl & ~RRF_HASX;
|
|
}
|
|
}
|
|
if ((fl & (RRF_HASX+RRF_HASY)) == 0) {
|
|
! entry is now empty, mark it deleted
|
|
if (((fl & RRF_ENTKEYX) && KOVIsBlockValue(kx)) ||
|
|
((ky ~= kx) && (fl & RRF_ENTKEYY) && KOVIsBlockValue(ky))) {
|
|
BlkValueFree(BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1));
|
|
}
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at, RRF_DELETED);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, 0);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 2, 0);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 3, 0);
|
|
BlkValueWrite(rel, RRV_USED, BlkValueRead(rel, RRV_USED) - 1);
|
|
} else {
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at, fl);
|
|
}
|
|
];
|
|
|
|
[ TwoInOneLookUp rel ke E ekflag hashv i free mask perturb flags;
|
|
!print "[2in1LU rel=", rel, " ke=", ke, " E=", E, " ekf=", ekflag, ": ";
|
|
! calculate a hash value for the key
|
|
hashv = GetHashValue(ke, E);
|
|
! look in the first expected slot
|
|
mask = BlkValueRead(rel, RRV_STORAGE);
|
|
i = hashv & mask;
|
|
!print "hv=", hashv, ", trying ", i;
|
|
flags = BlkValueRead(rel, RRV_DATA_BASE + 4*i);
|
|
if (flags == 0) {
|
|
!print " - not found]^";
|
|
return ~i;
|
|
}
|
|
if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) {
|
|
!print " - found]^";
|
|
return i;
|
|
}
|
|
! not here, keep looking in sequence
|
|
free = -1;
|
|
if (flags & RRF_DELETED) free = i;
|
|
perturb = hashv;
|
|
hashv = i;
|
|
for (::) {
|
|
hashv = hashv*5 + perturb + 1;
|
|
i = hashv & mask;
|
|
!print ", ", i;
|
|
flags = BlkValueRead(rel, RRV_DATA_BASE + 4*i);
|
|
if (flags == 0) {
|
|
!print " - not found]^";
|
|
if (free >= 0) return ~free;
|
|
return ~i;
|
|
}
|
|
if ((flags & ekflag) && TwoInOneEntryMatches(rel, i, ke, E)) {
|
|
!print " - found]^";
|
|
return i;
|
|
}
|
|
if ((free < 0) && (flags & RRF_DELETED)) free = i;
|
|
#ifdef TARGET_ZCODE;
|
|
@log_shift perturb (-RRP_PERTURB_SHIFT) -> perturb;
|
|
#ifnot;
|
|
@ushiftr perturb RRP_PERTURB_SHIFT perturb;
|
|
#endif;
|
|
}
|
|
];
|
|
|
|
[ TwoInOneCheckResize rel filled ext newext temp i at kov kx ky F E X Y;
|
|
filled = BlkValueRead(rel, RRV_FILLED);
|
|
ext = BlkValueRead(rel, RRV_STORAGE) + 1;
|
|
if (filled >= (ext - filled) * RRP_CROWDED_IS) {
|
|
! copy entries to temporary space
|
|
temp = FlexAllocate(ext * (4*WORDSIZE), TEXT_TY, BLK_FLAG_WORD+BLK_FLAG_MULTIPLE);
|
|
for (i=0: i<ext*4: i++)
|
|
BlkValueWrite(temp, i, BlkValueRead(rel, RRV_DATA_BASE+i), true);
|
|
! resize and clear our data
|
|
if (ext >= RRP_LARGE_IS) newext = ext * RRP_RESIZE_LARGE;
|
|
else newext = ext * RRP_RESIZE_SMALL;
|
|
BlkValueSetLBCapacity(rel, RRV_DATA_BASE + newext*4);
|
|
BlkValueWrite(rel, RRV_STORAGE, newext - 1);
|
|
BlkValueWrite(rel, RRV_FILLED, BlkValueRead(rel, RRV_USED));
|
|
for (i=0: i<newext*4: i++)
|
|
BlkValueWrite(rel, RRV_DATA_BASE+i, 0);
|
|
! copy entries back from temporary space
|
|
kov = BlkValueRead(rel, RRV_KIND);
|
|
kx = KindBaseTerm(kov, 0); ky = KindBaseTerm(kov, 1);
|
|
for (i=0: i<ext: i++) {
|
|
F = BlkValueRead(temp, 4*i, true);
|
|
if (F == 0 || (F & RRF_DELETED)) continue;
|
|
E = BlkValueRead(temp, 4*i + 1, true);
|
|
X = BlkValueRead(temp, 4*i + 2, true);
|
|
Y = BlkValueRead(temp, 4*i + 3, true);
|
|
if (F & RRF_ENTKEYX) at = TwoInOneLookUp(rel, kx, E, RRF_ENTKEYX);
|
|
else at = TwoInOneLookUp(rel, ky, E, RRF_ENTKEYY);
|
|
if (at >= 0) { print "*** Duplicate entry while resizing ***^"; rfalse; }
|
|
at = ~at;
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at, F);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 1, E);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 2, X);
|
|
BlkValueWrite(rel, RRV_DATA_BASE + 4*at + 3, Y);
|
|
}
|
|
! done with temporary space
|
|
FlexFree(temp);
|
|
}
|
|
];
|
|
|
|
[ TwoInOneEntryMatches rel at ke E ce;
|
|
ce = BlkValueRead(rel, RRV_DATA_BASE + 4*at + 1);
|
|
if (KOVIsBlockValue(ke)) {
|
|
if (BlkValueCompare(ce, E) ~= 0) rfalse;
|
|
} else {
|
|
if (ce ~= E) rfalse;
|
|
}
|
|
rtrue;
|
|
];
|
|
|
|
@p 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.
|
|
|
|
@c
|
|
[ RELATION_TY_Empty rel set handler;
|
|
handler = RlnGetF(rel, RR_HANDLER);
|
|
return handler(rel, RELS_EMPTY, set);
|
|
];
|