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