-- 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 April 12, 1983 10:31 am
--   Willie-Sue Haugeland on January 10, 1983 3:14 pm


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

DBModelSetImpl: PROGRAM
  IMPORTS DBHeapStorage, DBStorage,
     DB, DBModel, DBModelPrivate, Rope
  EXPORTS DB, DBModel, DBEnvironment =
   
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
    BEGIN -- Nested search of d and its subdomains
    IF start#First THEN SIGNAL Error[NotImplemented];
    es← NEW[EntitySetObject[nested]← [nested[
      remainingDomains: dl,
      lowName: lowName,
      highName: highName,
      currentEntitySet: QDomainSubset[d, lowName, highName, start, FALSE] ]]];
    RETURN[es]
    END;
    -- here so that don't include system or nested DomainSubsets
  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;
  
QRelationSubset: PUBLIC PROCEDURE[
  r: Relation, constraint: AttributeValueList, start: FirstLast← First] 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 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 ] ]];
    IF ~IsSystem[entityConstraint.attribute] THEN DBHeapStorage.Free[recVal];
    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)
  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, First, FALSE];
        es1.remainingDomains← es1.remainingDomains.rest;
        ENDLOOP };
    segment => {
      DO
        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, First, es1.searchSubDomains, 
          es1.remainingSegments.first ];
        es1.remainingSegments← es1.remainingSegments.rest;
        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 =>
      SIGNAL Error[NotImplemented]; -- Can't go backwards if there are subdomains
    segment => 
      SIGNAL Error[NotImplemented]; -- Can't go backwards on DomainDomain, RelationDomain
    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];
    index => DBStorage.CloseScanIndex[es1.scanHandle];
    tupleSet => DBStorage.CloseScanTupleset[es1.scanHandle];
    empty => NULL;
    segment => QReleaseEntitySet[es1.currentEntitySet]; 
    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];
    tupleSet => DBStorage.CloseScanTupleset[rs1.scanHandle];
    index => DBStorage.CloseScanIndex[rs1.scanHandle];
    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 -- StringType 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 StringType 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.