-- File: DBQImpl.mesa
-- Contents: Provides a layer on top of Cypress segments, so that read operations on relations and domains occur on the namesakes in ALL open segments, and write operations only in the segment in which the relation or domain handle was defined.
-- Last Edited by: Cattell, July 15, 1983 12:36 pm
-- Last Edited by: Elabbadi, July 21, 1983 4:05 pm

DIRECTORY DB, DBQ, DBEnvironment, DBTuplesConcrete, Rope;

DBQImpl: CEDAR PROGRAM
IMPORTS DB
EXPORTS DB, DBQ, DBEnvironment =

BEGIN OPEN DB;

ROPE: TYPE = Rope.ROPE;

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

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

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


QDomainSubset: PUBLIC PROCEDURE[
d: Domain, lowName, highName: ROPE← NIL, start: FirstLast← First,
searchSubDomains: BOOL← TRUE, segment: Segment← $ALL] RETURNS[es: EntitySet] =
BEGIN segmentList: LIST OF Segment← SegmentsFor[d];
IF segment#$ALL OR segmentList.rest=NIL THEN
RETURN[DB.DomainSubset[d, lowName, highName, start, searchSubDomains, segment]];
es← NEW[EntitySetObject[segment]← [segment[
remainingSegments: segmentList,
domain: d,
lowName: lowName,
highName: highName,
start: start,
searchSubDomains: searchSubDomains,
currentEntitySet: NIL
]]];
END;

QRelationSubset: PUBLIC PROCEDURE[
r: Relation, constraint: AttributeValueList, start: FirstLast← First] RETURNS [rs: RelshipSet] =
BEGIN segmentList: LIST OF Segment← SegmentsFor[r];
rs← NEW[RelshipSetObject[segment] ← [segment[
remainingSegments: segmentList,
relation: r,
constraint: constraint,
start: start,
currentRelshipSet: NIL
]]];
END;

QNextEntity: PUBLIC PROCEDURE[es: EntitySet] RETURNS[e: Entity] =
TRUSTED BEGIN otherD: DB.Domain;
WITH es1: es SELECT FROM
segment => {
DO
IF (e← DB.NextEntity[es1.currentEntitySet])#NIL THEN RETURN[e];
IF es1.remainingSegments=NIL THEN RETURN[NIL];
DB.ReleaseEntitySet[es1.currentEntitySet]; -- all done with this, get next
otherD← TranslateToSegment[es1.domain, es1.remainingSegments.first];
es1.currentEntitySet← DB.DomainSubset[
otherD, es1.lowName, es1.highName, es1.start, es1.searchSubDomains, NIL ];
es1.remainingSegments← es1.remainingSegments.rest;
ENDLOOP };
ENDCASE =>
RETURN[DB.NextEntity[es]];
END;

QNextRelship: PUBLIC PROCEDURE[rs: RelshipSet] RETURNS[t: Relship] =
TRUSTED BEGIN notFound: BOOL;
otherR: DB.Relation; otherL: AttributeValueList;
WITH rs1: rs SELECT FROM
segment =>
DO
IF (t← DB.NextRelship[rs1.currentRelshipSet])#NIL THEN RETURN[t];
IF rs1.remainingSegments=NIL THEN RETURN[NIL];
DB.ReleaseRelshipSet[rs1.currentRelshipSet]; -- all done with this, get next
otherR← TranslateToSegment[rs1.relation, rs1.remainingSegments.first];
[otherL, notFound]← TranslateConstraint[rs1.constraint, rs1.remainingSegments.first];
rs1.currentRelshipSet←
IF notFound THEN NIL ELSE DB.RelationSubset[otherR, otherL, rs1.start ];
rs1.remainingSegments← rs1.remainingSegments.rest;
ENDLOOP;
ENDCASE =>
RETURN[DB.NextRelship[rs]];
END;

QFetchEntity: PUBLIC PROC[
d: Domain, name: ROPE, segment: Segment← NIL] RETURNS [e: Entity] =
-- This is EXACTLY the same as DBModelBasicImpl.FetchEntity, just copied so that
-- it will call the DomainSubset above.
BEGIN
nextE: Entity;
es: EntitySet;
es← QDomainSubset[d, name,,,, segment];
e← QNextEntity[es];
nextE← QNextEntity[es];
ReleaseEntitySet[es];
IF Null[e] THEN RETURN[NIL];
IF NOT Null[nextE] THEN SIGNAL Error[MultipleMatch];
RETURN[e]
END;

QDeclareRelship: PUBLIC PROC[
r: Relation, init: AttributeValueList← NIL, version: Version← NewOrOld] RETURNS[t: Relship] =
-- Note the semantics when version=NewOnly slightly different than FetchRelship,
-- we want to create a new relship no matter what in this case while FetchRelship
-- checks to make sure it's the only one with these attribute values.
BEGIN
IF version=NewOnly OR init=NIL THEN RETURN[DB.CreateRelship[r, init]];
t← FetchRelship[r, init];
IF t=NIL AND version=NewOrOld THEN RETURN[DB.CreateRelship[r, init]];
END;

FetchRelship: PROC[r: Relation, avl: AttributeValueList] RETURNS[t: Relship] =
-- r must be a system or dictionary tupleset. Implemented by calling RelationSubset
-- and checking for exactly one match. Raises MultipleMatch if more than one
-- relship returned by RelationSubset. Returns NIL if no tuples match.
BEGIN
nextRel: Relship;
rs: RelshipSet;
rs← QRelationSubset[r, avl];
t← QNextRelship[rs];
nextRel← QNextRelship[rs];
DB.ReleaseRelshipSet[rs];
--IF nextRel#NIL THEN SIGNAL Error[MultipleMatch]; need this any more?
RETURN[t]
END;

QGetF: PUBLIC PROC[t: Relship, a: Attribute, string: BOOL← FALSE] RETURNS[v: Value] =
BEGIN
IF DB.SegmentOf[t] # DB.SegmentOf[a]
THEN a ← TranslateToSegment[a, DB.SegmentOf[t]];
RETURN[DB.GetF[t, a]];
END;

TranslateToSegment: PROC [e: Entity, s: Segment] RETURNS [Entity] =
-- Finds the namesake of e in segment s, returning NIL if there is none.
BEGIN
d: Domain← DB.DomainOf[e];
IF Eq[d, DomainDomain] THEN
RETURN[DB.DeclareDomain[DB.NameOf[e], s, OldOnly]]
ELSE IF Eq[d, RelationDomain] THEN
RETURN[DB.DeclareRelation[DB.NameOf[e], s, OldOnly]]
ELSE IF Eq[d, AttributeDomain] THEN
RETURN[DB.DeclareAttribute[
r: DB.DeclareRelation[DB.NameOf[V2E[DB.GetP[e, aRelationIs]]], s, OldOnly],
name: DB.NameOf[e],
version: OldOnly]]
ELSE
RETURN[DB.FetchEntity[TranslateToSegment[d, s], DB.NameOf[e], s]];
END;

TranslateConstraint: PROC [
avl: AttributeValueList, s: Segment] RETURNS [new: AttributeValueList, notFound: BOOL] =
-- Translates avl to segment s. Returns notFound=TRUE iff it couldn't find an entity
-- in avl in segment s.
BEGIN
notFound← FALSE; -- set if can't find something in the segment
new← NIL; -- will be the translated AttributeValueList
FOR avlT: AttributeValueList← avl, avlT.rest UNTIL avlT=NIL DO
tHi, tLo: REF ANY; attr: Attribute;
WITH avlT.first.lo SELECT FROM
e: Entity => tLo← TranslateToSegment[e, s];
ENDCASE => tLo← avlT.first.lo;
WITH avlT.first.hi SELECT FROM
e: Entity => tHi← TranslateToSegment[e, s];
ENDCASE => tHi← avlT.first.hi;
IF tLo=NIL THEN RETURN[NIL, TRUE];
attr← TranslateToSegment[avlT.first.attribute, s];
IF attr=NIL THEN RETURN[NIL, TRUE];
new← CONS[ [attribute: attr, lo: tLo, hi: tHi], new];
ENDLOOP;
END;

SegmentsFor: PROC [e: Entity] RETURNS[LIST OF Segment] = {
-- For now, this module just works for grapenut.
s: Segment← SegmentOf[e];
IF s=$Grapenut OR s=$Squirrel THEN
RETURN[LIST[$Squirrel, $Grapenut]]
ELSE RETURN[LIST[s]]};

END.