-- File: DBModelSetImpl.mesa
-- Contents: Implementation of aggregate / set operations on entities and tuples
-- Last edited by:
-- Eric Bier on 18-Aug-81 14:51:15
-- Rick Cattell on December 15, 1983 2:54 pm
-- Willie-Sue Haugeland on January 10, 1983 3:14 pm


DIRECTORY
DBEnvironment USING [TupleObject],
DBStorage,
DBTuplesConcrete,
DB,
DBModel,
DBModelPrivate,
Rope;

DBModelSetImpl: PROGRAM
IMPORTS DBStorage, DB, DBModel, DBModelPrivate, Rope
EXPORTS DB, DBEnvironment, DBModel =

BEGIN OPEN DB, DBModelPrivate, DBModel;


ROPE: TYPE = Rope.ROPE;

-- Counts for balancing Subset/Release calls

entitySetCount: PUBLIC INT← 0;
relshipSetCount: PUBLIC INT← 0;


-- opaque type objects: exported DBTuplesConcrete => DBModel

TupleObject: PUBLIC TYPE = DBTuplesConcrete.TupleObject;
EntityObject: PUBLIC TYPE = TupleObject;
RelshipObject: PUBLIC TYPE = TupleObject;

EntitySetObject: PUBLIC TYPE = DBTuplesConcrete.EntitySetObject;
RelshipSetObject: PUBLIC TYPE = DBTuplesConcrete.RelshipSetObject;


-- REFS to opaque type objects

Tuple, TupleSet, Index, IndexFactor: TYPE = REF TupleObject;
Domain, Relation, Entity, Attribute, DataType: PUBLIC TYPE = REF EntityObject;
Relship: PUBLIC TYPE = REF RelshipObject;

SystemATuple: TYPE = REF attribute TupleObject;
SystemSTuple: TYPE = REF surrogate TupleObject;
SystemTSTuple: TYPE = REF tupleSet TupleObject;

EntitySet: PUBLIC TYPE = REF EntitySetObject;
RelshipSet: PUBLIC TYPE = REF RelshipSetObject;


-- Simple narrowing conversions. Since a tuple is a REF, explicit narrowing is sometimes necessary.

T2SAT: PROCEDURE[t: Tuple] RETURNS [SystemATuple] =
INLINE BEGIN RETURN [NARROW[t]] END;

T2ST: PROCEDURE[t: Tuple] RETURNS [SystemTSTuple] =
INLINE BEGIN RETURN [NARROW[t]] END;

T2SST: PROC[t: Tuple] RETURNS [SystemSTuple] =
INLINE BEGIN RETURN [NARROW[t]] END;


-- Searching the database

QDomainSubset: PUBLIC PROCEDURE[
d: Domain, lowName, highName: ROPE← NIL, start: FirstLast← First,
searchSubDomains: BOOL← TRUE, segment: Segment← NIL] RETURNS[es: EntitySet] =
-- Used with NextEntity to index through entities in a domain. searchSubDomains
-- says whether to search any Domains related to d through the SubType relation.
-- If segment is non-NIL, then domain d is only searched in the given segment;
-- for non-system domains, this argument is currently ignored.
-- If lowName and highName are non-NIL, enumerates only those entities whose name
-- is lexicographically >= lowName and <=highName, and the enumeration is sorted.
-- In this case, we create an "index" variant of DBTuplesConcrete.EntitySetObject.
-- If only highName is NIL, it defaults to lowName, i.e. we will search for the entity
-- whose name equals lowName. If both are NIL, we create an unindexed (tupleSet variant)
-- EntitySet.
BEGIN
dl: LIST OF Domain;
CheckDomain[d];
entitySetCount← entitySetCount+1;
IF IsSystem[d] THEN
IF start=First THEN RETURN[SystemDomainSubset[d, lowName, highName, segment]]
ELSE {SIGNAL Error[NotImplemented]; RETURN[NIL]};
IF searchSubDomains AND (dl← GetCachedDomainInfo[d].subDomains)#NIL THEN
-- Here so that don't include system or nested DomainSubsets
BEGIN -- Nested search of d and its subdomains
es← NEW[EntitySetObject[nested]← [nested[
previousDomains: IF start=Last THEN CONS[d, dl] ELSE NIL,
remainingDomains: IF start=First THEN Reverse[CONS[d, dl]] ELSE NIL,
lowName: lowName,
highName: highName,
start: start,
currentEntitySet: NIL ]]];
RETURN[es]
END;
IF lowName#NIL THEN
BEGIN -- Search using index
i: Index← GetCachedDomainInfo[d].nameIndex;
lowName← NCode[lowName];
highName← IF highName=NIL THEN lowName ELSE NCode[highName];
es← NEW[EntitySetObject[index] ← [
index [ DBStorage.OpenScanIndex[i, [lowName, highName, TRUE, TRUE], start ]]] ];
END
ELSE
-- Enumerate entire domain using tupleset scan
es← NEW[EntitySetObject[tupleSet] ← [tupleSet [DBStorage.OpenScanTupleset[d, start] ]] ];
RETURN[es];
END;

Reverse: PUBLIC PROC [list: LIST OF Entity] RETURNS [val: LIST OF Entity] = {

QRelationSubset: PUBLIC PROCEDURE[
r: Relation, constraint: AttributeValueList, start: FirstLast← First, searchSegment: Segment← NIL]
RETURNS [rs: RelshipSet] =
-- Relation r must be a system or dictionary relation, and constraints only on its attributes.
-- The full RelationSubset algorithm is described in the model level design document. Briefly,
-- there are 7 cases, corresponding to the legal combinations of several orthogonal choices:
-- (1) Is r a surrogate relation? If so, will be doing index, group, or tupleset scan on domain.
-- (2) Special-case r surrogate with first attribute constraint on entity in r's target domain.
-- (3) Is there a useful index on r? This can be true whether r is surrogate or not.
-- (4) Is one of the constraints entity-valued (group-scannable)? r can be surrogate or not.
-- (5) If all else fails, use a tupleset scan (even if r is surrogage), NextRelship will filter.
-- In both the surrogate and normal case, we try for an index scan before trying for a
-- group scan, and try for a group scan before resorting to a tupleset scan.
-- We handle almost all of the surrogate and normal cases with one flow of control, by
-- independently setting the surrogate relation field in the index, tupleset, or group scan.
-- Exception: if r is surrogate and (a) is the case, can use a "justOne" scan.
-- Note system relations are handled just as dictionary relations. In this case,
-- the constraint values determine what segment will be searched, as the relation and
-- constraint attributes give no hint! The group scan which results, however, searches
-- only the appropriate segment, e.g. in RelationSubset[aType, LIST[[aTypeIs, foo]]] searches
-- only the segment of foo.
BEGIN
surrogateR: Relation; -- NIL if not surrogate relation
targetAttr: Attribute; -- target attribute if surrogate relation
targetTupleset: DBStorage.TuplesetHandle; -- target domain if r is surrogate relation, else r
entityConstraint: AttributeValue; -- entity-valued constraint if group scannable
reducedList: AttributeValueList; -- remainder of constraint if group or index scannable
recVal: DBStorage.FieldHandle; -- handle to pass to storage level for group scans
groupScannable: BOOL;
indexScan: DBStorage.IndexScanHandle;
-- (0) Check that valid parameters
CheckRelation[r]; IF CheckAVList[constraint] THEN RETURN;
IF searchSegment#NIL THEN SIGNAL Error[NotImplemented];
IF r=dSubType AND constraint=NIL THEN SIGNAL Error[NotImplemented];
relshipSetCount← relshipSetCount+1;
-- (1) Determine whether surrogate or normal relation
IF V2B[SafeGetP[r, r1to1Prop]] THEN
-- there is not actually a relation, tuples are targetted to the domain ref'd by 1st attrib
BEGIN
surrogateR← r;
targetAttr← GetFirstAttribute[r];
targetTupleset← V2E[SafeGetP[targetAttr, aTypeIs]];
END
ELSE -- normal relation
BEGIN
surrogateR← NIL;
targetTupleset← r
END;
-- (2) Try for one-element scan on the target attribute if a surrogate relation
IF surrogateR#NIL AND constraint#NIL AND Eq[constraint.first.attribute, targetAttr] THEN
BEGIN -- no search necessary, want tuple that corresponds to one entity in targetDomain
t: Relship← SurrogateCreateRelship[r];
T2SST[t].vEntity← V2E[constraint.first.lo];
IF constraint.rest=NIL OR MatchingRelship[t, constraint.rest] THEN
rs← NEW[RelshipSetObject[justOne]← [justOne [hereItIs: t]]]
ELSE
rs← NIL;
RETURN
END;
-- (3) Try for index scan
[indexScan, reducedList]← FindIndexedConstraint[r, constraint, start];
IF indexScan#NIL THEN
BEGIN
rs← NEW[RelshipSetObject[index] ← [index [
serialCheck: reducedList,
scanHandle: indexScan,
surrogate: surrogateR ] ]];
RETURN;
END;
-- (4) Try for group scan
[entityConstraint, reducedList, groupScannable]← FindEntityConstraint[constraint];
IF groupScannable THEN
BEGIN
recVal← V2Rec[SafeGetP[entityConstraint.attribute, aHandleProp]];
rs← NEW[RelshipSetObject[group] ← [group [
serialCheck: reducedList,
scanHandle: DBStorage.OpenScanGroup [V2E[entityConstraint.lo], recVal, start],
surrogate: surrogateR ] ]];
END
-- (5) Resort to scanning the whole tupleset, either the relation r or if r is surrogate then the
-- domain ref'd by r's 1st attrib; NextRelship will serially check constraint
ELSE
BEGIN
rs← NEW[RelshipSetObject[tupleSet]← [tupleSet [
serialCheck: constraint,
scanHandle: DBStorage.OpenScanTupleset[targetTupleset, start],
surrogate: surrogateR ]]];
END;
END;

FindEntityConstraint: PROC [constraint: AttributeValueList]
RETURNS [con: AttributeValue, reducedList: AttributeValueList, found: BOOLEAN] =
-- Looks for an entity-valued constraint in the AttributeValueList on which a group
-- scan could be done (i.e., must be a linked attribute). Used by QRelationSubset above.
-- Must explicitly check for system attributes, which GetCachedAttributeInfo doesn't handle.
BEGIN
reducedList← NIL;
found← FALSE;
FOR conL: AttributeValueList← constraint, conL.rest UNTIL conL = NIL DO
a: Attribute = conL.first.attribute;
type: ValueType; -- type of this attribute
link: LinkType; -- whether it is linked
IF IsSystem[a] THEN {type← T2SAT[a].vType; link← Linked}
ELSE [type: type, link: link]← GetCachedAttributeInfo[a];
IF IsDomainType[type] AND (link=Linked OR link=Colocated) THEN
{con← conL.first; GOTO Found}
ELSE
reducedList← CONS[conL.first, reducedList];
REPEAT
Found =>
BEGIN
  found← TRUE;
  FOR conT: AttributeValueList← conL.rest, conT.rest UNTIL conT = NIL DO
  reducedList← CONS[conT.first, reducedList];
  ENDLOOP
  END;
FINISHED => con← [NIL, NIL, NIL]; -- return found=FALSE and dummy values.
ENDLOOP;
RETURN
END;

FindIndexedConstraint: PROC[r: Relation, constraint: AttributeValueList, start: FirstLast]
RETURNS [is: DBStorage.IndexScanHandle, reducedList: AttributeValueList] =
-- Looks for an index to search to satisfy the constraint, if any. Returns [NIL, constraint]
-- if none. Else returns an appropriate index scan handle for the index, and the reduced
-- constraint list (those constraint elements that are not indexed by the B-tree).
-- Tries all indexes that involve the first attribute in the constraint, returns the first one
-- that indexes one or more of the attributes in the constraint. Used by QRelationSubset.
BEGIN
i: Index;
ifs: LIST OF IndexFactor;
lowKey, highKey: ROPE;
IF constraint=NIL OR IsSystem[r] THEN RETURN[NIL, constraint];
ifs← GetCachedAttributeInfo[constraint.first.attribute].indexFactors;
FOR ifs← ifs, ifs.rest UNTIL ifs=NIL DO
i← V2E[SafeGetP[ifs.first, ifIndexIs]];
SELECT CanUseIndex[i, constraint] FROM
different =>
NULL;
identical => {
lowKey← NCodeForTupleMatch[constraint, i, low];
highKey← NCodeForTupleMatch[constraint, i, high];
reducedList← NIL;
GO TO FoundAnIndex;
};
indexSuperset => {
lowKey← NCodeForTupleMatch[constraint, i, low];
highKey← NCodeForTupleMatch[constraint, i, high];
reducedList← NIL;
GO TO FoundAnIndex;
};
matchSuperset => {
lowKey← NCodeForTupleMatch[constraint, i, low];
highKey← NCodeForTupleMatch[constraint, i, high];
reducedList← constraint;
GO TO FoundAnIndex;
};
ENDCASE => ERROR;
REPEAT
FoundAnIndex =>
RETURN[DBStorage.OpenScanIndex[
i, [lowKey, highKey, TRUE, TRUE], start], reducedList];
FINISHED =>
RETURN[NIL, constraint];
ENDLOOP;
END;

CanUseIndex: PROCEDURE[i: Index, tm: AttributeValueList]
RETURNS[{different, identical, indexSuperset, matchSuperset}] =
-- Determines whether the index factors of the given index, when compared in order to the
-- attribute matches in the given tm, (a) differ at any point, (b) are identical and are equal in
-- number, (c) are identical as far as they go but the index includes additional factors not
-- in tm, or (d) are identical but tm includes additional matches.
-- Used by FindIndexedConstraint above.
BEGIN
if: IndexFactor; count: INT← 0;
ifs: LIST OF IndexFactor← VL2EL[QGetPList[i, ifIndexOf]];
FOR tmL: AttributeValueList← tm, tmL.rest UNTIL tmL=NIL DO
IF ifs=NIL AND count>0 THEN RETURN[matchSuperset];
if← ifs.first; ifs← ifs.rest;
IF count#V2I[SafeGetP[if, ifOrdinalPositionIs]] THEN ERROR InternalError;
IF NOT Eq[V2E[SafeGetP[if, ifAttributeIs]], tmL.first.attribute] THEN RETURN[different];
count← count+1;
ENDLOOP;
IF ifs=NIL THEN RETURN[identical]
ELSE RETURN[indexSuperset];
END;

QGetAllRefAttributes: PUBLIC PROCEDURE[e: Entity] RETURNS[al: AttributeList] =
-- Find all the attributes in which some relationship references e. We do this just by
-- calling DBStorage.GetGroupIDs to get attributes that reference in other tuples (al3 below),
-- and combining the result with any surrogate relation attributes that are actually
-- stored as fields of e itself (al2), and any unlinked relation attributes that might reference
-- e (al1). We don't actually check to see if the latter reference e, because we don't want to
-- pay the cost of the RelationSubset; the client can check.
-- Note: DBModelPrivateImpl.DestroyLinksTo depends on the result of this proc to destroy
-- references to entities. It must therefore return unlinked attributes, and it must
-- find client attributes referencing dictionary (Domain, Relation, etc.) entities.
BEGIN al1, al2, al3: LIST OF Attribute← NIL;
CheckEntity[e];
IF NOT IsSystem[e] THEN {
al1← GetDomainUnlinkedRefAttributes[QDomainOf[e]];
al2← GetDomainSurrogateRefAttributes[QDomainOf[e]] };
al3← DBStorage.GetGroupIDs[e];
RETURN[Nconc[Nconc[al1, al2], al3]];
END;

QGetDomainRefAttributes: PUBLIC PROC[d: Domain] RETURNS[al: AttributeList] =
-- Used to find all attrs reffing d or a superdomain of d.
-- This differs from above because it gets ALL, not just ones that ref a particular entity.
BEGIN CheckDomain[d];
IF IsSystem[d] THEN {SIGNAL Error[NotImplemented]; RETURN[NIL]};
al← GetDomainDirectRefAttributes[d];
FOR dl: LIST OF Domain← FindSuperDomains[d], dl.rest UNTIL dl=NIL DO
al← Nconc[al, GetDomainDirectRefAttributes[dl.first]] ENDLOOP;
RETURN[al]
END;

GetDomainDirectRefAttributes: PROC[d: Domain] RETURNS[al: AttributeList] =
-- Returns ALL attributes whose type is d (surrogate, linked, or unlinked), but
-- not ones whose type is a supertype of d.
{RETURN[VL2EL[QGetPList[d, aTypeOf]]]};

GetDomainSurrogateRefAttributes: PROC[d: Domain] RETURNS[al: AttributeList] =
-- Returns attributes that appear to reference d, but are actually stored as fields of d's entities.
{RETURN[VL2EL[QGetPList[d, aDomainOf]]]};

GetDomainUnlinkedRefAttributes: PROC[d: Domain] RETURNS[al: AttributeList] =
-- Returns attributes that reference d, but by entity name instead of explicit (group) link.
{RETURN[VL2EL[QGetPList[d, aUnlinkedOf]]]};

-- Enumeration operations

QNextEntity: PUBLIC PROCEDURE[es: EntitySet] RETURNS[e: Entity] =
-- Find the next element from the scan ordering that also matches the es.serialMatch.
-- Operations depend on type of scan, see DBTuplesConcrete for explanation of the
-- EntitySetObject variants. We can handle:
-- (1) tupleSet scan simply chaining through ALL entities in a domain,
-- (2) nested scan through currentEntitySet till exhausted, then next in remainingDomains
-- (3) segment scan through currentEntitySet till exhausted, then next in remainingSegments
-- (4) group scan finds all entities reffing some entity (used on surrogate fields)
-- (5) attributeSet goes through all relations, and all attributes for each
-- (6) system scan follows linked list through system entities
-- (7) empty scan always returns NIL (used for some special cases)
-- Invariant maintained by this procedure and PrevEntity: currentEntitySet is always valid
-- for nested and segment EntitySets.
BEGIN
IF es=NIL THEN RETURN[NIL];
WITH es1: es SELECT FROM
tupleSet =>
e← DBStorage.NextScanTupleset[es1.scanHandle];
nested => {
DO
IF (e← QNextEntity[es1.currentEntitySet])#NIL THEN RETURN[e];
IF es1.remainingDomains=NIL THEN RETURN[NIL];
QReleaseEntitySet[es1.currentEntitySet]; -- all done with this, get next
es1.currentEntitySet← QDomainSubset[
es1.remainingDomains.first, es1.lowName, es1.highName, es1.start, FALSE];
es1.previousDomains← CONS[es1.remainingDomains.first, es1.previousDomains];
es1.remainingDomains← es1.remainingDomains.rest;
ENDLOOP };
segment => {
DO
oldOne: LIST OF Segment;
IF (e← QNextEntity[es1.currentEntitySet])#NIL THEN RETURN[e];
IF es1.remainingSegments=NIL THEN RETURN[NIL];
QReleaseEntitySet[es1.currentEntitySet]; -- all done with this, get next
es1.currentEntitySet← QDomainSubset[
es1.domain, es1.lowName, es1.highName, es1.start, es1.searchSubDomains,
es1.remainingSegments.first ];
oldOne← es1.remainingSegments; es1.remainingSegments← es1.remainingSegments.rest;
oldOne.rest← es1.previousSegments; es1.previousSegments← oldOne;
ENDLOOP };
index =>
e← DBStorage.NextScanIndex[es1.scanHandle];
empty =>
e← NIL;
ENDCASE => SIGNAL InternalError;
END;

QPrevEntity: PUBLIC PROCEDURE[es: EntitySet] RETURNS[e: Entity] =
-- Similar to QNextEntity, but backs up to previous entity. Not yet implemented for all cases.
BEGIN
IF es=NIL THEN RETURN[NIL];
WITH es1: es SELECT FROM
tupleSet =>
e← DBStorage.PrevScanTupleset[es1.scanHandle];
nested => {
-- Note: on nested EntitySets, we assume we are scanning es.previousDomains.first, regardless of
-- whether we are doing PrevEntity or NextEntity calls. Thus, when we run out of entries in
-- the current entity set going backward, the next guy to scan is es.previousDomains.rest.first,
-- and we must move es.previousDomains.first to es.remainingDomains so that we'll get it if
-- we change directions again.
DO
IF (e← QPrevEntity[es1.currentEntitySet])#NIL THEN RETURN[e];
-- If previousDomains is NIL, we've tried to back up past beginning and the
-- currentEntitySet is NIL; it signals to QNextEntity to start again with remainingDomains.
IF es1.previousDomains=NIL THEN RETURN[NIL];
QReleaseEntitySet[es1.currentEntitySet];
-- All done with currentEntitySet now, move one of previousDomains to remainingDomains.
es1.remainingDomains← CONS[es1.previousDomains.first, es1.remainingDomains];
es1.previousDomains← es1.previousDomains.rest;
-- If previousDomains is NIL now, nothing left to scan, and currentEntitySet empty.
IF es1.previousDomains=NIL THEN {es1.currentEntitySet← NIL; RETURN[NIL]};
es1.currentEntitySet← QDomainSubset[
es1.previousDomains.first, es1.lowName, es1.highName, Last, FALSE];
ENDLOOP };
segment => {
DO
oldOne: LIST OF Segment;
IF (e← QPrevEntity[es1.currentEntitySet])#NIL THEN RETURN[e];
IF es1.previousSegments=NIL THEN RETURN[NIL];
QReleaseEntitySet[es1.currentEntitySet]; -- all done with this, get next
es1.currentEntitySet← QDomainSubset[
es1.domain, es1.lowName, es1.highName, es1.start, es1.searchSubDomains,
es1.previousSegments.first ];
oldOne← es1.previousSegments; es1.previousSegments← es1.previousSegments.rest;
oldOne.rest← es1.remainingSegments; es1.remainingSegments← oldOne;
ENDLOOP };
index =>
e← DBStorage.PrevScanIndex[es1.scanHandle];
empty =>
e← NIL;
ENDCASE => SIGNAL InternalError;
END;

QNextRelship: PUBLIC PROCEDURE[rs: RelshipSet] RETURNS[t: Relship] =
-- Find the next element from the scan ordering (which is an index, group, or tupleset
-- scan, see RelationSubset) that also matches the rs.serialCheck. The latter match is
-- done by the following two internal routines. These two routines (MatchingRelship,
-- MatchingAttribute) are for internal use only, they assume their arguments are reasonable.
-- An index, group, or tupleset scan can be on a domain tupleset rather than relation tupleset
-- if the relation is a surrogate relation. In that case we use ConsSurrogate below to create
-- the surrogate relship corresponding to the entity the index, group, or tupelset scan returned.
BEGIN
ConsSurrogate: PROC[r: Relation] RETURNS [newT: Relship] =
{newT← SurrogateCreateRelship[r]; T2SST[newT].vEntity← t; RETURN[newT]};
IF rs=NIL THEN RETURN[NIL];
WITH rs1: rs SELECT FROM
tupleSet =>
WHILE (t← DBStorage.NextScanTupleset[rs1.scanHandle])#NIL DO
IF rs1.surrogate#NIL THEN t← ConsSurrogate[rs1.surrogate];
IF MatchingRelship[t, rs1.serialCheck] THEN RETURN
ENDLOOP;
group =>
WHILE (t← DBStorage.NextInGroup[rs1.scanHandle])#NIL DO
IF rs1.surrogate#NIL THEN t← ConsSurrogate[rs1.surrogate];
IF MatchingRelship[t, rs1.serialCheck] THEN RETURN
ENDLOOP;
index =>
WHILE (t← DBStorage.NextScanIndex[rs1.scanHandle])#NIL DO
IF rs1.surrogate#NIL THEN t← ConsSurrogate[rs1.surrogate];
IF MatchingRelship[t, rs1.serialCheck] THEN RETURN
ENDLOOP;
justOne =>
IF rs1.hereItIs#NIL THEN
{t← rs1.hereItIs; rs1.hereItIs← NIL; RETURN[t]};
ENDCASE => SIGNAL InternalError;
-- We reach here iff there were no remaining tuples in the index or tupleset scan
--which satisfied the serialMatch constraints.
RETURN[NIL];
END;

QPrevRelship: PUBLIC PROCEDURE[rs: RelshipSet] RETURNS[t: Relship] =
-- Similar to QNextRelship, but goes backward to previous; not implemented for all cases.
BEGIN
ConsSurrogate: PROC[r: Relation] RETURNS [newT: Relship] =
{newT← SurrogateCreateRelship[r]; T2SST[newT].vEntity← t; RETURN[newT]};
IF rs=NIL THEN RETURN[NIL];
WITH rs1: rs SELECT FROM
tupleSet =>
WHILE (t← DBStorage.PrevScanTupleset[rs1.scanHandle])#NIL DO
IF rs1.surrogate#NIL THEN t← ConsSurrogate[rs1.surrogate];
IF MatchingRelship[t, rs1.serialCheck] THEN RETURN
ENDLOOP;
group =>
WHILE (t← DBStorage.PrevInGroup[rs1.scanHandle])#NIL DO
IF rs1.surrogate#NIL THEN t← ConsSurrogate[rs1.surrogate];
IF MatchingRelship[t, rs1.serialCheck] THEN RETURN
ENDLOOP;
index =>
WHILE (t← DBStorage.PrevScanIndex[rs1.scanHandle])#NIL DO
IF rs1.surrogate#NIL THEN t← ConsSurrogate[rs1.surrogate];
IF MatchingRelship[t, rs1.serialCheck] THEN RETURN
ENDLOOP;
justOne =>
SIGNAL Error[NotImplemented];
ENDCASE => SIGNAL InternalError;
-- We reach here iff there were no remaining tuples in the index or tupleset scan
--which satisfied the serialMatch constraints.
RETURN[NIL];
END;

-- The following two routines used only by Next/PrevRelship above, they assume ok args.

MatchingRelship: PROCEDURE[rel: Relship, alh: AttributeValueList] RETURNS[BOOLEAN] =
-- Returns TRUE iff every attribute of t satisfies alh's constraints.
--INLINE-- BEGIN
FOR alhL: AttributeValueList← alh, alhL.rest UNTIL alhL=NIL DO
IF NOT MatchingAttribute[rel, alhL.first] THEN RETURN[FALSE] ENDLOOP;
RETURN[TRUE]
END;

MatchingAttribute: PROCEDURE[rel: Relship, alh: AttributeValue] RETURNS[ans: BOOLEAN] =
-- Returns TRUE iff t satisfies alh's constraint (on alh.attribute).
--INLINE-- BEGIN
s: ROPE← NCode[QGetF[rel, alh.attribute]];
low: ROPE← NCode[alh.lo];
high: ROPE←
IF alh.hi=NIL THEN low
ELSE NCode[alh.hi];
vt: DataType← V2E[SafeGetP[alh.attribute, aTypeIs]];
-- typeOfalhLo: DataType← TypeOf[alh.lo];
-- IF NOT Eq[vt, typeOfalhLo] THEN SIGNAL InternalError;
ans← GreaterEqString[s, low] AND GreaterEqString[high, s];
END;

QReleaseEntitySet: PUBLIC PROCEDURE[es: EntitySet] =
BEGIN
entitySetCount← entitySetCount - 1;
IF es=NIL THEN RETURN;
WITH es1: es SELECT FROM
nested => {QReleaseEntitySet[es1.currentEntitySet]; es1.currentEntitySet← NIL};
index => {DBStorage.CloseScanIndex[es1.scanHandle]; es1.scanHandle← NIL};
tupleSet => {DBStorage.CloseScanTupleset[es1.scanHandle]; es1.scanHandle← NIL};
segment => {QReleaseEntitySet[es1.currentEntitySet]; es1.currentEntitySet← NIL};
empty => NULL;
ENDCASE => ERROR;
END;

QReleaseRelshipSet: PUBLIC PROCEDURE[rs: RelshipSet] =
BEGIN
relshipSetCount← relshipSetCount - 1;
IF rs=NIL THEN RETURN;
WITH rs1: rs SELECT FROM
group => {DBStorage.CloseScanGroup[rs1.scanHandle]; rs1.scanHandle← NIL};
tupleSet => {DBStorage.CloseScanTupleset[rs1.scanHandle]; rs1.scanHandle← NIL};
index => {DBStorage.CloseScanIndex[rs1.scanHandle]; rs1.scanHandle← NIL};
segment => {QReleaseRelshipSet[rs1.currentRelshipSet]; rs1.currentRelshipSet← NIL};
justOne => NULL;
ENDCASE => ERROR;
END;


-- General support routines

QEntitySetToList: PUBLIC PROC[es: EntitySet] RETURNS [el: LIST OF Entity] =
BEGIN
e: Entity← QNextEntity[es];
IF e=NIL THEN
{QReleaseEntitySet[es]; RETURN[NIL]}
ELSE
RETURN[CONS[e, QEntitySetToList[es]]];
END;

QRelshipSetToList: PUBLIC PROC[rs: RelshipSet] RETURNS [el: LIST OF Relship] =
BEGIN
r: Relship← QNextRelship[rs];
IF r=NIL THEN
{QReleaseRelshipSet[rs]; RETURN[NIL]}
ELSE
RETURN[CONS[r, QRelshipSetToList[rs]]];
END;


CheckAVList: PROC[avl: AttributeValueList] RETURNS [abort: BOOL] =
-- Checks to make sure types of attributes and lo/hi's match.
-- Returns TRUE if should abort operation
-- This procedure only checks for system entities right now.
BEGIN
FOR avlT: AttributeValueList← avl, avlT.rest UNTIL avlT=NIL DO
alh: AttributeValue = avl.first;
WITH alh.lo SELECT FROM
-- abort if any system tuples, attributes cannot have system-tuple values
t: Tuple => IF IsSystem[t] THEN RETURN[TRUE];
ENDCASE;
ENDLOOP;
RETURN[FALSE]
END;

NCodeForTupleMatch: PROCEDURE[
tm: AttributeValueList, i: Index, extreme: {high, low}] RETURNS[ROPE] =
-- Encodes the attribute values specified in tm (using lowValues if extreme = low,
-- else highValues) as required by index i. Uses appropriate extreme values for
-- attributes among the index factors of i but not in tm. Omits attributes in tm but
-- not among the index factors. A null byte is inserted between each attribute value
-- to preserve the lexicographic ordering of the attributes. If extreme=high then either
-- one or four 377C bytes are added on the end for any attributes in the index but not
-- given values in tm, to insure that the result will be greater or equal to any value
-- for these attributes in the index.
BEGIN
count: INT← 0;
s: ROPE← "";
v: Value← NIL;
if: IndexFactor;
ifType: DataType;
ifs: LIST OF IndexFactor← VL2EL[QGetPList[i, ifIndexOf]];
FOR tmL: AttributeValueList← tm, tmL.rest UNTIL tmL=NIL DO
-- Find index factor for tmL.first and concatenate the corresponding value
IF ifs=NIL THEN
-- No more index factors but there are more attributes in tm: remaining attributes will
-- be checked by serial match, and all tm attributes are bounded by s (above or below).
RETURN[s];
if← ifs.first; ifs← ifs.rest;
IF NOT Eq[V2E[SafeGetP[if, ifAttributeIs]], tmL.first.attribute] THEN
ERROR InternalError; -- CanUseIndex only succeeds if same order as index factors
IF count#V2I[SafeGetP[if, ifOrdinalPositionIs]] THEN ERROR InternalError;
v← IF extreme=low OR tmL.first.hi=NIL THEN tmL.first.lo ELSE tmL.first.hi;
s← Rope.Cat[s, NCode[v], "\000"];
count← count+1;
ENDLOOP;
IF extreme=high THEN
-- Indexed attributes are superset of match's: append extreme value for leftover index factors
FOR ifs← ifs, ifs.rest UNTIL ifs=NIL DO
if← ifs.first;
ifType← V2E[SafeGetP[V2E[SafeGetP[if, ifAttributeIs]], aTypeIs]];
IF ifType=IntType OR ifType=TimeType THEN
s← s.Concat["\377\377\377\377"]
ELSE -- RopeType or entity name
s← s.Concat["\377"];
ENDLOOP;
RETURN[s];
END;

GreaterEqString: PROC[s1, s2: ROPE] RETURNS[BOOLEAN] =
-- Returns TRUE iff s1 is lexically greater or equal to s2.
BEGIN RETURN[Rope.Compare[s1, s2] # less] END;

Nconc: PROC[l1, l2: LIST OF Entity] RETURNS [LIST OF Entity] =
BEGIN lp: LIST OF Entity← l1;
IF l1=NIL THEN RETURN[l2];
FOR lp← l1, lp.rest UNTIL lp.rest=NIL DO ENDLOOP;
lp.rest← l2;
RETURN[l1];
END;

END.

Last edited by:

Cattell previous to 24-Nov-81 11:40:52: lots of edits for DBView level.

Cattell on 24-Nov-81 11:40:52: QRelationSubset on relations with surrogate tuples. Allow N-attribute surrogates, too.

Cattell 24-Nov-81 18:04:57: forgot to check for new surrogates in QReleaseRelshipSet.

Cattell 25-Nov-81 9:32:20: reformatted some procs, fixed up comments

Cattell 25-Nov-81 16:52:30: QGetEntityByName should use version OldOnly

Cattell 26-Nov-81 11:03:22: Amazing. QDomainSubset wasn't checking for hi=NIL in nameConstraint so it couldn't have been working, and it was assuming NameProp was the first in constraintList.

Cattell 26-Nov-81 12:14:14: More amazing. Guess Eric checked even less of his code than i thought. ConstraintOfProp and EntityValuedPLH didn't produce reducedList correctly under any circumstances, and EntityValuedPLH always returned found=FALSE.

Cattell 26-Nov-81 13:17:22: NCodeName needn't put NUL on the end; still needs to be coded to work with multi-part names, though.

Cattell 28-Dec-81 8:56:32: Changed NCode to return NIL for NIL arg and MatchingEntity doesn't check types because it's inadequate to deal with subdomains, etc., right now. Really need a CompatibleType[actual, required: DataType] RETURNS [BOOLEAN] that special-cases aTypeProp, the built-in datatypes, and subdomains.

Cattell 29-Dec-81 14:03:53: Wow! Spent parts of four days trying to figure out this one 'cause the behavior led me elsewhere. the assignment to es1.attributes in QNextEntity didn't work because es was copied in the discrimination. Changed to an old-style variant discrimination instead of new-style REF discrimination. Here's that bug you couldn't find at the end of the summer, Eric!

Cattell 29-Dec-81 16:37:46: More bugs in QNextEntity. WHILE (rel← ...) DO {loop with no ref to rel!!?}. Just rewrote it all, changed variants around alot. Don't need system variant, Eric intended group variant for IndexTS and IndexFactorTS.

Cattell 6-Jan-82 12:57:18: Fixed TransitiveClosure: needs both from and to till have N-to-M props.

Cattell April 27, 1982 8:59 pm [10]: Fixed TransitiveClosure: was storing the Relship in thisSub.

Cattell April 28, 1982 8:25 am: Changed NCode to convert to upper case. Presumably all index entry, lookup, and conversion for index comparison goes through NCode, thus this will result in indexes requiring upper-case equivalence only.

Cattell April 29, 1982 5:15 pm [100]: Bier also had the same bug fixed 26-Nov-81 12:14:14 in FindEntityConstraint. Sigh. Also removed RelshipsReffing, which wasn't used.

Cattell April 29, 1982 7:19 pm [100]: Ouch. QRelationSubset[r, LIST[[foo, baz]]], when foo is an attribute targetted to baz's domain, was enumerating the entire domain! Changed to simply return a surrogate tuple for baz. This required inventing a new RelshipSet variant named justOne.

Cattell April 29, 1982 8:22 pm: Added DBStats.

Cattell May 4, 1982 9:13 am: Allow lookup of DomainDomain, etc., independent of case of name.

Cattell May 22, 1982 2:40 pm: Made Fetch1Entity work with system Datatypes and Subtype relation and attributes.

Cattell August 1, 1982 1:21 pm: Changed CheckAVList to check for NIL passed as value of anything besides a RopeType field. Previously added CheckAVList, forgot to add to change log.

Cattell October 11, 1982 3:57 pm: Implemented timing of critical DBView operations. Removed GetRefProps. Changed some errors to signals.

Cattell November 4, 1982 11:30 am: Changes for new properties and indices. Mainly changed the algorithms used by RelationSubset and NextRelship. Algorithm more completely described in View Level Design document.

Cattell December 17, 1982 4:06 pm: New segments. Changed DomainSubset, RelationSubset, etc. Moved DBStats.

Cattell January 13, 1983 9:42 am: Changed GetAllRefAttributes to find aUnlinked ones.

Cattell January 28, 1983 12:29 pm: Fixed NCodeForTupleMatch to handle IntType and DateType fields properly: must concatenate four bytes of 377C's for any leftover index items not in the attribute value list if extreme=high; only use one if string or entity type attribute. FindIndexedConstraint had a minor bug: don't need to concatenate 0C's or 377C's there since NCodeForTupleMatch handles them.

Cattell on February 2, 1983 4:46 pm: Fixed QRelationSubset to deal with surrogate case when cosntraint.rest#NIL.

Cattell on February 8, 1983 11:39 am: Oops! Forgot to remove cosntraint.rest=NIL check in IF statment in above change.

Cattell on March 14, 1983 2:37 pm: Changed FindEntityConstraint to use GetCachedAttributeInfo, to speed it up getting the type and link fields of attributes in the list. Similarly for FindIndexedConstraint.

Cattell on March 15, 1983 2:28 pm: Oops. Above changes caused bug: GetCachedAttributeInfo doesn't work on system attributes. Fixed FindEntityConstraint to check for them.