1. Creating and destroying entities and relationships
QDeclareEntity:
PUBLIC
PROC[d: Domain, name:
ROPE←
NIL, version: Version← NewOrOld]
RETURNS [e: Entity] =
BEGIN
GenSym:
PROC[d: Domain]
RETURNS[e: Entity] =
BEGIN -- generates a unique anonymous entity
ENABLE DB.Error => TRUSTED {IF code=NonUniqueEntityName THEN RETRY};
random: LONG CARDINAL ← LOOPHOLE[BasicTime.GetClockPulses[]];
name: ROPE ← IO.PutR[IO.card[random]];
e ← CreateEntity[d, name];
END;
IF QNullDomain[d] THEN ERROR DB.Error[IllegalDomain];
IF DBModelSchema.InvalidDomain[d] THEN ERROR DB.Error[InvalidSchema];
IF d.isSystem THEN ERROR DB.Error[IllegalDomain];
IF name =
NIL
THEN
-- Automatically generate new name/entity if no name given
IF version=OldOnly THEN RETURN[NIL] ELSE {e ← GenSym[d]; RETURN};
e ← FetchEntity[d, name];
IF e =
NIL
THEN
IF version#OldOnly THEN e← CreateEntity[d, name] ELSE NULL
ELSE
-- e#NIL
IF version=NewOnly THEN ERROR DB.Error[AlreadyExists] ELSE RETURN;
END;
FetchEntity:
PROC[d: Domain, name:
ROPE]
RETURNS [e: Entity] =
Checks to see if the entity already exists. If so, it returns it, if not, it returns NIL.
If more than one entity satisfies the constraints, it signals MultipleMatch.
Uses segment arg only for dictionary entity lookup, to know which segment to search.
Checks explicitly for lookup of the system entities.
BEGIN
nextE: Entity;
es: EntitySet; esi: CARDINAL;
IF fakeTransAbort THEN ERROR DB.Aborted[QGetSegmentInfo[d.segment.segment].trans];
IF QDomainEq[d, DomainDomain]
THEN
SELECT
TRUE
FROM
name.Equal["Domain", FALSE] => RETURN[DomainDomain.tuple];
name.Equal["Relation", FALSE] => RETURN[RelationDomain.tuple];
name.Equal["Attribute", FALSE] => RETURN[AttributeDomain.tuple];
name.Equal["DataType", FALSE] => RETURN[DataTypeDomain.tuple];
name.Equal["Index", FALSE] => RETURN[IndexDomain.tuple];
name.Equal["IndexFactor", FALSE] => RETURN[IndexFactorDomain.tuple];
ENDCASE => NULL;
[es, esi] ← GetNewEntitySet[];
es← QDomainSubset[d: d, lowName: name, es: es];
e← QNextEntity[es];
nextE← QNextEntity[es];
QReleaseEntitySet[es];
ReturnEntitySet[esi];
IF NullEntity[e] THEN RETURN[NIL];
IF NOT NullEntity[nextE] THEN ERROR DB.Error[MultipleMatch];
RETURN[e]
END;
CreateEntity:
PROC [d: Domain, name:
ROPE]
RETURNS [e: Entity] =
Creates a new entity in d. The domain d must be a client-defined (dictionary). Enters
the entity in d's name index.
BEGIN
DBStats.Inc[CreateEntity];
e← DBStorage.CreateTuple[DBModelSchema.GetDomainTuple[d]];
IF name=
NIL
THEN
CreateEntityIndexEntries[e] -- we may disallow this name=NIL case soon
ELSE
ChangeNameBody[e: e, s: name, eD: d, existingIndexEntry:
FALSE
! DB.Error => TRUSTED {IF code=NonUniqueEntityName THEN DBStorage.DestroyTuple[e]} ];
END;
StringToValue:
PROC[s:
ROPE, a: Attribute]
RETURNS[Value] =
Converts a string to a value of the type required by a, doing the appropriate
string conversion or a Fetch if type is a Domain.
TRUSTED BEGIN pos: INT;
SELECT a.type
FROM
RopeType =>
RETURN[DB.S2V[s]];
IntType =>
IF s.Length[]=0 THEN RETURN[DB.I2V[0]] ELSE RETURN[DB.I2V[RopeToInt[s]]];
TimeType =>
IF s.Length[]=0 THEN RETURN[DB.T2V[LOOPHOLE[LONG[0]]]]
ELSE RETURN[DB.T2V[RopeToTime[s]]];
BoolType =>
IF s.Equal["TRUE"] THEN RETURN[DB.B2V[TRUE]]
ELSE IF s.Equal["FALSE"] THEN RETURN[DB.B2V[FALSE]]
ELSE ERROR DB.Error[MismatchedAttributeValueType];
AnyDomainType =>
Must search every domain in the system unless s contains domain name or is empty
IF s.Length[]=0 THEN RETURN[[null[]]]
ELSE
IF (pos← s.Find[":"])#-1
THEN
BEGIN -- treat s as name of an entity in a.type
vtd: Domain ← QDeclareDomain[s.Substr[0, pos], a.relation.segment.segment, OldOnly];
IF QNullDomain[vtd] THEN ERROR DB.Error[NotFound];
RETURN[DB.E2V[FetchEntity[vtd, s.Substr[pos+2]]]];
END
ELSE
-- no "domain: value" specified
BEGIN
d: Domain; e: Entity;
ds: DomainSet; dsi: CARDINAL;
[ds, dsi] ← GetNewDomainSet[];
ds ← QEnumerateDomains[segment: a.relation.segment.segment, lowName: "", ds: ds];
UNTIL QNullDomain[d← QNextDomain[ds]]
DO
e← QDeclareEntity[d, s, OldOnly ];
IF e#NIL THEN { QReleaseDomainSet[ds]; ReturnDomainSet[dsi]; RETURN[DB.E2V[e]] };
ENDLOOP;
we reach here if NO domain contained an entity named e.
QReleaseDomainSet[ds]; ReturnDomainSet[dsi];
ERROR DB.Error[NotFound];
END;
ENDCASE => ERROR DB.Error[MismatchedAttributeValueType]
END;
RopeToTime:
PROC[s:
ROPE]
RETURNS [gmt: BasicTime
.GMT] =
BEGIN
gmt← IO.GetTime[IO.RIS[s] ! IO.Error => ERROR DB.Error[MismatchedAttributeValueType]];
END;
RopeToInt:
PROC[s:
ROPE]
RETURNS [i:
INT] =
BEGIN ENABLE IO.Error => ERROR DB.Error[MismatchedAttributeValueType];
i← IO.GetInt[IO.RIS[s]];
END;
IsData:
PROC[t: TupleHandle]
RETURNS[
BOOL] =
INLINE BEGIN
IF t.tid<MaxVTID THEN RETURN[FALSE]; -- system tuple
TRUSTED {
t1: TupleHandle ← DBStorage.ReadTupleset[t];
RETURN[t1.tid>=MaxVTID] };
END;
QDestroyEntity:
PUBLIC
PROC[e: Entity] =
Destroys a data tuple, by:
(1) deleting all references to it in indexes and groups,
(2) calling the storage level to destroy the tuple itself, its TH,
and invalidate all THs containing the same tid.
BEGIN
DBStats.Starting[DestroyEntity];
IF NullEntity[e] THEN RETURN;
IF IsSystem[e]
THEN
ERROR DB.Error[DictionaryUpdate]
ELSE
BEGIN
DestroyLinksTo[e]; -- This also destroys any surrogate relation index entries
DestroyEntityIndexEntries[e]; -- This destroys the name index entry
SetValFromHandle[e, defaultNameHandle, RopeType, , nullValue]; -- So DBStorage doesn't crash
DBStorage.DestroyTuple[e];
END;
DBStats.Stopping[DestroyEntity];
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
privateInit: PrivateAttributeValueList;
IF QNullRelation[r] THEN ERROR DB.Error[IllegalRelation];
IF DBModelSchema.InvalidRelation[r] THEN ERROR DB.Error[InvalidSchema];
privateInit ← MakePrivate[init];
IF version=NewOnly OR init=NIL THEN RETURN[CreateRelship[r, privateInit]];
t← FetchRelship[r, init];
IF t=NIL AND version=NewOrOld THEN RETURN[CreateRelship[r, privateInit]];
END;
MakePrivate:
PROC[pubList: AttributeValueList]
RETURNS[PrivateAttributeValueList] =
BEGIN
IF pubList =
NIL
THEN
RETURN[
NIL]
ELSE
RETURN[
CONS[
[ pubList.first.attribute, [public[pubList.first.lo]], [public[pubList.first.hi]] ], MakePrivate[pubList.rest] ]]
END;
CreateRelship:
PUBLIC
PROC[r: Relation, init: PrivateAttributeValueList←
NIL]
RETURNS[t: Relship] =
Creates a new tuple in r; r must be relation entity. Enters the new relationship
in any appropriate indexes.
BEGIN
DBStats.Inc[CreateRelship];
IF r.isSystem THEN ERROR DB.Error[DictionaryUpdate];
IF r.is1to1 THEN RETURN[SurrogateCreateRelship[r, init]];
t← DBStorage.CreateTuple[DBModelSchema.GetRelationTuple[r]];
IF init#
NIL
THEN SetMultipleF[t, init
! DB.Error => TRUSTED {IF code=NonUniqueKeyValue THEN DBStorage.DestroyTuple[NARROW[t]]} -- clean up -- ];
CreateAllIndexEntries[t];
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; rsi: CARDINAL;
[rs, rsi] ← GetNewRelshipSet[];
rs← QRelationSubset[r, avl, First, rs];
t← QNextRelship[rs];
nextRel← QNextRelship[rs];
QReleaseRelshipSet[rs];
ReturnRelshipSet[rsi];
IF nextRel#NIL THEN ERROR DB.Error[MultipleMatch]; -- need this any more?
RETURN[t]
END;
SurrogateCreateRelship:
PUBLIC
PROC[r: Relation, init: PrivateAttributeValueList]
RETURNS[SurrogateRelshipHandle] =
Note that unlike ordinary CreateRelship, we do not create any index entries; creating
a surrogate Relship just creates a surrogate referring to the actual entries, the index
entries are created or destroyed with the entity in which the data reside.
BEGIN t: SurrogateRelshipHandle;
DBStats.Inc[SurrogateCreateRelship];
t← NEW[DBDefs.SurrogateRelshipObject];
t.relation← r;
t.targetAttribute← GetFirstAttribute[r];
Note that t.vEntity is not yet known!
IF init#NIL THEN SetMultipleF[t, init];
RETURN[t]
END;
QDestroyRelship:
PUBLIC
PROC[t: Relship] =
Destroys a (non-schema) relationship, by:
(1) destroying any index entries referencing this relationship
(2) removing it from any DBStorage groups by NILing out entity-valued fields,
(3) NILing out string-valued fields to get rid of any dangling strings created by DBStorage
(4) invalidating tupleset cache and calling the storage level to destroy the TupleHandle,
Invalidates all TupleHandles containing the same tid as a side effect of (4).
Constraints: Must destroy index entries (1) before NILing out entity refs and strings
because they are used to figure out which index entries to destroy. Steps (2) and (3)
bypass the normal creating/destroying index entries on attribute update, for efficiency.
BEGIN
DBStats.Starting[DestroyRelship];
WITH t
SELECT
FROM
t1: TupleHandle => {
r: Relation;
IF NullRelship[t1] THEN { DBStats.Stopping[DestroyRelship]; RETURN };
r ← GetCachedRelshipInfo[SegmentOf[t1], t1];
IF r.isSystem THEN ERROR DB.Error[DictionaryUpdate];
IF r.is1to1
THEN {
SurrogateDestroyRelship[t1];
DBStats.Stopping[DestroyRelship];
RETURN };
DestroyAllIndexEntries[t1, r]; -- (1)
DestroyVariableFieldsOf[t1, r]; -- (2)
DBStorage.DestroyTuple[t1] }; -- (3)
t2: SurrogateRelshipHandle => SurrogateDestroyRelship[t2];
ENDCASE => ERROR DB.Error[IllegalRelship];
DBStats.Stopping[DestroyRelship];
END;
DestroyVariableFieldsOf:
PROC[t: Relship, r: Relation] =
NIL out variable-length string attributes so that DBStorage deletes "string tuples" associated
with t for strings that overflow the length specified for the attribute. Does NOT create
or destroy any index entries associated with the attribute, the caller must do that. Also destroys backlinks to t (in groups) by storing NIL in those attributes (a) of t
that point to entities (the Storage level removes the corresponding backlinks).
BEGIN
FOR al:
LIST
OF Attribute← r.attributes, al.rest
UNTIL al=
NIL
DO
a: Attribute ← al.first;
IF a.type = RopeType THEN QSetF[t, al.first, [null[]], FALSE] ELSE
IF a.type = AnyDomainType
OR IsDomainType[a.type] THEN
This NILs out field whether it was link field or string field (want to either way).
We disable update of index entries for efficiency, we'll destroy them later.
QSetF[t, a, [null[]], FALSE ! DB.InternalError => TRUSTED {IF desperate THEN CONTINUE}];
ENDLOOP;
END;
SurrogateDestroyRelship:
PROC[t: Relship] =
Puts an appropriate null value in all attributes but the first (which refs the entity in
which the others are actually stored).
BEGIN
rel1: Relation;
as: LIST OF Attribute;
DBStats.Inc[SurrogateDestroyRelship];
WITH t
SELECT
FROM
t1: TupleHandle => rel1 ← GetCachedRelshipInfo[SegmentOf[t1], t1];
t2: SurrogateRelshipHandle => rel1 ← t2.relation;
ENDCASE => ERROR DB.Error[IllegalRelship];
as← rel1.attributes.rest; -- skip the target attribute
null out all other attributes of t's relship
FOR as← as, as.rest
UNTIL as=
NIL
DO
QSetF[t, as.first, MakeNullValueOfType[as.first.type]];
ENDLOOP;
DestroyAllIndexEntries[t, rel1];
END;
2. Getting and setting names and attributes
QEntityInfo:
PUBLIC
PROC [e: Entity]
RETURNS [name:
ROPE, domain: Domain] =
BEGIN
DBStats.Starting[EntityInfo];
IF IsSystem[e] THEN ERROR DB.Error[IllegalEntity];
[name, domain] ← GetCachedEntityInfo[SegmentOf[e], e];
DBStats.Stopping[EntityInfo];
RETURN[name, domain];
NameOf:
PUBLIC
PROC [e: Entity, domain: Domain]
RETURNS [name:
ROPE] =
Works on system, dictionary, and data entities.
BEGIN
IF IsSystem[e]
THEN {
IF e.name = NIL THEN ERROR InternalError ELSE RETURN[e.name] };
IF QDomainEq[domain, DomainDomain]
OR QDomainEq[domain, RelationDomain]
THEN
-- name always second field of these:
name← PV2S[GetValFromHandle[e, tupleSetNameHandle, RopeType ]]
ELSE
IF QDomainEq[domain, AttributeDomain]
THEN
name← PV2S[GetValFromHandle[e, attributeNameHandle, RopeType ]]
ELSE
name← PV2S[GetValFromHandle[e, defaultNameHandle, RopeType ]];
RETURN[name];
END;
ChangeName:
PUBLIC
PROC [e: Entity, s:
ROPE] =
BEGIN
eD: Domain ← GetCachedEntityInfo[SegmentOf[e], e].domain;
IF eD.isSystem
THEN
-- ChangeName is only write operation permitted on dictionary entities
DictionaryChangeName[e, s]
ELSE {
old: Entity← FetchEntity[eD, s];
IF old#NIL THEN
IF EntityEq[old, e] THEN RETURN -- e already has this name
ELSE ERROR DB.Error[NonUniqueEntityName];
ChangeNameBody[e, s, eD] };
END;
ChangeNameBody:
PROC [e: Entity, s:
ROPE, eD: Domain, existingIndexEntry:
BOOL ←
TRUE] =
Check that name is unique for this domain unless null, then set it
and make an entry in the name index for this domain.
BEGIN
IF s=NIL THEN s← "";
IF existingIndexEntry THEN DestroyEntityIndexEntries[e];
SetValFromHandle[e, defaultNameHandle, RopeType, , S2PV[s]];
CreateEntityIndexEntries[e];
END;
DictionaryChangeName:
PROC [e: Entity, s:
ROPE] =
On system entities, must use special name handles according to position of name field
BEGIN
name: ROPE; eD: Domain;
index: DBStorage.IndexHandle;
[name, eD] ← GetCachedEntityInfo[SegmentOf[e], e];
IF QDomainEq[eD, AttributeDomain]
THEN
{SetValFromHandle[e, attributeNameHandle, RopeType, , S2PV[s]]; RETURN}
ELSE IF QDomainEq[eD, DomainDomain] THEN index← GetDomainIndex[eD.segment]
ELSE IF QDomainEq[eD, RelationDomain] THEN index← GetRelationIndex[eD.segment]
ELSE ERROR DB.Error[IllegalEntity]; -- Don't know of any other system domains
Set name of domain or relation and re-enter in the index
DBStorage.DeleteFromIndex[index, ConvertToUpper[name], e];
SetValFromHandle[e, tupleSetNameHandle, RopeType, , S2PV[s]];
DBStorage.InsertIntoIndex[index, ConvertToUpper[s], e];
END;
QGetF:
PUBLIC
PROC[t: Relship, a: Attribute, string:
BOOL←
FALSE]
RETURNS[Value] =
Gets attribute a of t by calling the appropriate DBStorage routine.
We handle surrogate tuples as special case. GetAttributeInfo and
GetValFromHandle deal correctly with the other two cases: (1) t is dictionary
tuple, a is system tuple and (2) t is data tuple, a is dictionary tuple.
If string is TRUE, attribute is fetched as string regardless of actual type;
this is used to over-ride translation of string to entity on remote entity types.
BEGIN ENABLE DB.InternalError => {IF desperate THEN GOTO GiveUp};
WITH t
SELECT
FROM
t1: TupleHandle => {
DBStats.Starting[GetF];
IF NullRelship[t1] THEN ERROR DB.Error[IllegalRelship];
IF QNullAttribute[a] THEN ERROR DB.Error[IllegalAttribute];
IF DBModelSchema.InvalidAttribute[a] THEN ERROR DB.Error[InvalidSchema];
{ pv: PrivateValue ← GetValFromHandle[t1, a.fh, IF string THEN RopeType ELSE a.type, a.link];
DBStats.Stopping[GetF];
RETURN[PV2V[pv]] } };
t2: SurrogateRelshipHandle => {
IF QNullAttribute[a] THEN ERROR DB.Error[IllegalAttribute];
IF DBModelSchema.InvalidAttribute[a] THEN ERROR DB.Error[InvalidSchema];
RETURN[SurrogateGetF[t2, a, string]] };
ENDCASE => ERROR InternalError;
EXITS GiveUp => RETURN[[null[]]]
END;
QGetFS:
PUBLIC
PROC[t: Relship, a: Attribute]
RETURNS [v:
ROPE] =
BEGIN temp: Entity;
IF NullRelship[t] THEN ERROR DB.Error[IllegalRelship];
IF QNullAttribute[a] THEN ERROR DB.Error[IllegalAttribute];
IF DBModelSchema.InvalidAttribute[a] THEN ERROR DB.Error[InvalidSchema];
SELECT a.type
FROM
RopeType =>
RETURN[V2S[QGetF[t,a]]];
IntType =>
RETURN[IO.PutR[IO.int[V2I[QGetF[t, a]]]]];
TimeType =>
RETURN[IO.PutR[IO.time[V2T[QGetF[t, a]]]]];
BoolType =>
RETURN[IF V2B[QGetF[t, a]] THEN "TRUE" ELSE "FALSE"];
RecordType => ERROR DB.Error[NotImplemented];
ENDCASE =>
-- must be an entity
IF a.link=Unlinked
OR a.link=Remote
THEN
We can fetch name string directly, don't need to GetF the entity itself
RETURN[V2S[QGetF[t, a, TRUE]]]
ELSE
Fetch the entity, return null if null, prepend domain if AnyDomainType
IF NullEntity[temp← V2E[QGetF[t, a]]] THEN v ← ""
ELSE
IF a.type#AnyDomainType
THEN
v ← GetCachedEntityInfo[a.relation.segment, temp].name
ELSE {
name: ROPE; domain: Domain;
[name, domain] ← GetCachedEntityInfo[a.relation.segment, temp];
v ← Rope.Cat[domain.name, ": ", name] };
END;
SurrogateGetF:
PROC [t: SurrogateRelshipHandle, a: Attribute, string:
BOOL]
RETURNS [Value] =
Retrieves field of surrogate tuple
BEGIN
rel1: Relation ← t.relation;
IF QNullRelation[rel1] THEN ERROR DB.Error[IllegalAttribute];
IF DBModelSchema.InvalidRelation[rel1] THEN ERROR DB.Error[InvalidSchema];
DBStats.Starting[SurrogateGetF];
IF NOT QRelationEq[a.relation, rel1] THEN ERROR DB.Error[IllegalAttribute];
IF QAttributeEq[a, t.targetAttribute]
THEN {
the silly case: retrieving back the entity the relship corresponds to
v: Value ← DB.E2V[t.entity];
DBStats.Stopping[SurrogateGetF];
RETURN[v] }
ELSE
normal case: must retrieve attribute of target domain instead
BEGIN
{ pv: PrivateValue ← GetValFromHandle[t.entity, a.fh, IF string THEN RopeType ELSE a.type, a.link ];
DBStats.Stopping[SurrogateGetF];
RETURN[PV2V[pv]] }
END;
END;
QSetF:
PUBLIC
PROC[t: Relship, a: Attribute, v: Value, updateIndices:
BOOL←
TRUE] =
Call appropriate DBStorage routine according to field type.
"t" must be a data or surrogate tuple, "a" must be a dictionary tuple.
TRUSTED BEGIN ENABLE DB.InternalError => TRUSTED {IF desperate THEN CONTINUE};
WITH t
SELECT
FROM
t1: SurrogateRelshipHandle => {
IF QNullAttribute[a] THEN ERROR DB.Error[IllegalAttribute];
IF DBModelSchema.InvalidAttribute[a] THEN ERROR DB.Error[InvalidSchema];
SurrogateSetF[t1, a, [public[v]]]; RETURN };
t2: TupleHandle => {
indexFactors: LIST OF IndexFactor ← NIL;
indexList: LIST OF Index ← NIL;
DBStats.Starting[SetF];
IF NullRelship[t2] THEN ERROR DB.Error[IllegalRelship];
IF QNullAttribute[a] THEN ERROR DB.Error[IllegalAttribute];
IF DBModelSchema.InvalidAttribute[a] THEN ERROR DB.Error[InvalidSchema];
IF IsDictionary[t2] THEN ERROR DB.Error[DictionaryUpdate];
WITH v: v
SELECT
FROM
null => NULL;
ENDCASE =>
IF (a.uniqueness=Key
OR a.uniqueness=OptionalKey)
AND NOT a.relation.is1to1 THEN
check for uniqueness
BEGIN
other: Relship← FetchRelship[a.relation, LIST[[a, v]]];
IF other#NIL THEN ERROR DB.Error[NonUniqueKeyValue];
END;
IF updateIndices
THEN {
indexFactors ← VL2TL[QGetPList[DBModelSchema.GetAttributeTuple[a], ifAttributeOf]];
FOR ifs:
LIST
OF IndexFactor ← indexFactors, ifs.rest
UNTIL ifs =
NIL
DO
indexList ← CONS[PV2E[SafeGetP[ifs.first, ifIndexIs]], indexList];
ENDLOOP };
IF updateIndices THEN DestroyIndexEntries[t, indexList];
SetValFromHandle[t2, a.fh, a.type, a.link, [public[v]]];
IF updateIndices THEN CreateIndexEntries[t, indexList];
DBStats.Stopping[SetF]; };
ENDCASE => ERROR InternalError;
END;
IsDictionary:
PROC[t: TupleHandle]
RETURNS[
BOOL] =
INLINE BEGIN
IF t.tid<MaxVTID THEN RETURN[FALSE];
TRUSTED {
t1: TupleHandle ← DBStorage.ReadTupleset[t];
RETURN[t1.tid<MaxVTID] };
END;
SafeSetF:
PUBLIC
PROC[t: Relship, a: Attribute, v: PrivateValue] =
Exported to DBModelPrivate; for setting ordinary or surrogate dictionary tuple attributes.
BEGIN
DBStats.Inc[DictionarySetF];
WITH t
SELECT
FROM
t1: SurrogateRelshipHandle => SurrogateSetF[t1, a, v];
t2: TupleHandle => SetValFromHandle[t2, a.fh, a.type, a.link, v];
ENDCASE => ERROR InternalError;
RETURN;
END;
QSetFS:
PUBLIC
PROC[t: Relship, a: Attribute, v:
ROPE] = {
Attempts to convert v to attribute of type required for attribute a of t.
Signals MismatchedAttributeValue if can't.
QSetF[t, a, StringToValue[v, a]] };
SurrogateSetF:
PROC [t: SurrogateRelshipHandle, a: Attribute, v: PrivateValue] =
Set field of a surrogate tuple. This may be a dictionary tuple, although only if
called through SafeSetF since QSetF (called by client) will give error in that case.
TRUSTED BEGIN
DBStats.Starting[SurrogateSetF];
IF QAttributeEq[a, t.targetAttribute]
THEN {
v1: Value ← PV2V[v];
resetting t's entity; the semantics of this are tricky
WITH v1
SELECT
FROM
null =>
IF t.entity#
NIL
THEN
ERROR DB.Error[NotImplemented] -- Can't reset target if relation is surrogate
entity =>
IF
NOT CompatibleDomain[GetCachedEntityInfo[a.relation.segment, V2E[v1]].domain, a.type]
THEN
ERROR DB.Error[MismatchedAttributeValueType]
ELSE {
IF t.entity#NIL THEN ERROR DB.Error[NotImplemented]
ELSE t.entity← V2E[v1] }
ENDCASE => ERROR DB.Error[MismatchedAttributeValueType] }
ELSE
-- normal case, setting Nth (N>1) attribute: aHandleProp gives handle in domain
IF t.entity=NIL THEN ERROR DB.Error[MustSetKeyAttributeFirst]
ELSE
BEGIN
indexFactors: LIST OF IndexFactor ← VL2TL[QGetPList[DBModelSchema.GetAttributeTuple[a], ifAttributeOf]];
indexList: LIST OF Index ← NIL;
FOR ifs:
LIST
OF IndexFactor ← indexFactors, ifs.rest
UNTIL ifs =
NIL
DO
indexList ← CONS[PV2E[SafeGetP[ifs.first, ifIndexIs]], indexList];
ENDLOOP;
DestroyIndexEntries[t, indexList];
SetValFromHandle [t.entity, a.fh, a.type, a.link, v ];
CreateIndexEntries[t, indexList];
END;
DBStats.Stopping[SurrogateSetF];
END;
3. Miscellaneous exported procedures
EntityEq:
PUBLIC
SAFE
PROC[e1, e2: Entity]
RETURNS[
BOOL] =
TRUSTED
If e1 or e2 are NIL or nullified, returns TRUE iff the other is, too.
Else if e1 and e2 are in the same segment, returns TRUE iff e1 and e2 ref same entity.
Else returns FALSE.
BEGIN
IF NullEntity[e1] THEN RETURN[NullEntity[e2]];
IF NullEntity[e2] THEN RETURN[FALSE];
IF SameSegment[e1, e2]
OR IsSystem[e1]
OR IsSystem[e2]
THEN
RETURN[e1.tid=e2.tid]
ELSE RETURN[FALSE];
END;
RelshipEq:
PUBLIC
SAFE
PROC [r1, r2: Relship]
RETURNS[
BOOL] = {
IF r1=NIL THEN RETURN[NullRelship[r2]];
IF r2=NIL THEN RETURN[NullRelship[r1]];
WITH r1
SELECT
FROM
r1t: TupleHandle => {
WITH r2
SELECT
FROM
r2t: TupleHandle => RETURN[EntityEq[r1t, r2t]];
r2s: SurrogateRelshipHandle => RETURN[FALSE];
ENDCASE => ERROR };
r1s: SurrogateRelshipHandle => {
WITH r2
SELECT
FROM
r2t: TupleHandle => RETURN[FALSE];
r2s: SurrogateRelshipHandle => RETURN[EntityEq[r1s.entity, r2s.entity]];
ENDCASE => ERROR };
ENDCASE => ERROR;
};
NullEntity:
PUBLIC
SAFE
PROC[e: Entity]
RETURNS[
BOOL] =
CHECKED
BEGIN RETURN[e=NIL OR e.tid=0] END;
NullRelship:
PUBLIC
SAFE PROC [r: Relship]
RETURNS[
BOOL] = {
IF r=NIL THEN RETURN[TRUE];
WITH r
SELECT
FROM
r1: TupleHandle => RETURN[r1=NIL OR r1.tid=0];
r2: SurrogateRelshipHandle => RETURN[NullEntity[r2.entity]];
ENDCASE => ERROR;
};
QDomainEq:
PUBLIC
PROC [d1, d2: Domain]
RETURNS[
BOOL] = {
IF QNullDomain[d1] OR QNullDomain[d2] THEN RETURN[FALSE];
IF DBModelSchema.InvalidDomain[d1]
OR DBModelSchema.InvalidDomain[d2]
THEN ERROR DB.Error[InvalidSchema];
RETURN[Rope.Equal[d1.name, d2.name] AND d1.segment=d2.segment] };
QRelationEq:
PUBLIC
PROC [r1, r2: Relation]
RETURNS[
BOOL] = {
IF QNullRelation[r1] OR QNullRelation[r2] THEN RETURN[FALSE];
IF DBModelSchema.InvalidRelation[r1]
OR DBModelSchema.InvalidRelation[r2]
THEN ERROR DB.Error[InvalidSchema];
RETURN[Rope.Equal[r1.name, r2.name] AND r1.segment=r2.segment] };
QAttributeEq:
PUBLIC
PROC [a1, a2: Attribute]
RETURNS[
BOOL] = {
IF QNullAttribute[a1] OR QNullAttribute[a2] THEN RETURN[FALSE];
IF DBModelSchema.InvalidAttribute[a1]
OR DBModelSchema.InvalidAttribute[a2]
THEN ERROR DB.Error[InvalidSchema];
RETURN[Rope.Equal[a1.name, a2.name] AND QRelationEq[a1.relation, a2.relation]] };
QNullDomain:
PUBLIC
PROC [d: Domain]
RETURNS[
BOOLEAN] = {
IF d=NIL OR (d.version=NIL AND ~d.isSystem) THEN RETURN[TRUE] ELSE RETURN[FALSE] };
QNullRelation:
PUBLIC
PROC [r: Relation]
RETURNS[
BOOLEAN] = {
IF r=NIL OR (r.version=NIL AND ~r.isSystem) THEN RETURN[TRUE] ELSE RETURN[FALSE] };
QNullAttribute:
PUBLIC
PROC [a: Attribute]
RETURNS[
BOOLEAN] = {
IF a=NIL OR (a.version=NIL AND ~a.isSystem) THEN RETURN[TRUE] ELSE RETURN[FALSE] };
QRelationOf:
PUBLIC
PROC [t: Relship]
RETURNS [r: Relation] =
BEGIN
DBStats.Inc[RelationOf];
IF NullRelship[t] THEN ERROR DB.Error[IllegalRelship];
TRUSTED {
WITH t
SELECT
FROM
t1: TupleHandle => RETURN[GetCachedRelshipInfo[SegmentOf[t1], t1]];
t2: SurrogateRelshipHandle => RETURN[t2.relation];
ENDCASE => ERROR;
};
END;
4. Miscellaneous support routines
GetValFromHandle:
PUBLIC PROC [
t: TupleHandle, fh: DBStorage.FieldHandle, ft: DataType, fl: LinkType← Linked]
RETURNS [PrivateValue] =
All fetch operations go through this lowest level procedure. Its arguments (which give the
handle, type, and link bool) should have been fetched by a call to GetAttributeInfo.
We make a special case here for the simulated system attributes aTypeIs and aLinkIs
(See explanation in DBModelSystemImpl of these attributes).
BEGIN
SELECT ft
FROM
IntType =>
IF fh = aLinkIs.fh THEN RETURN[U2PV[GetTypeAndLink[t].link]]
ELSE RETURN[I2PV[LOOPHOLE[DBStorage.Read2Word[t, fh]]]];
TimeType => {
time: BasicTime.GMT;
time← BasicTime.FromPupTime[DBStorage.Read2Word[t, fh]
! BasicTime.OutOfRange => {time← BasicTime.nullGMT; CONTINUE}];
RETURN[T2PV[time]];
};
RopeType =>
RETURN[S2PV[DBStorage.ReadVarByte[t, fh]]];
RecordType => {
WARNING: if we ever fetch any RecordType fields other than field handles,
the following won't do! We'll have to pass down the REF for ReadNWord.
newfh: DBStorage.FieldHandle ← DBStorage.CreateFieldHandle[];
DBStorage.ReadNWord[t, fh, newfh]; RETURN[[handle[newfh]]] };
BoolType =>
RETURN[B2PV[LOOPHOLE[DBStorage.Read1Word[t, fh]]]];
ENDCASE =>
-- ft is a domain
IF fl=Linked
OR fl=Colocated
THEN
-- linked entity, stored as tuple ref
RETURN[E2PV[DBStorage.ReadTID[t, fh]]]
ELSE
IF fl=Unlinked
THEN
-- entity name stored, look up the corresponding entity in ft
RETURN[E2PV[QDeclareEntity[DataTypeToDomain[ft, SegmentOf[t]], PV2S[GetValFromHandle[t, fh, RopeType]]]]]
ELSE
-- entity is remote, look up entity in another segment
RETURN[E2PV[IDToEntity[PV2S[GetValFromHandle[t, fh, RopeType]]]]];
END;
SetValFromHandle:
PUBLIC
PROC [
t: TupleHandle, fh: DBStorage.FieldHandle, ft: DataType, fl: LinkType← Linked, v: PrivateValue] =
All store operations go through this lowest level procedure. Its arguments (which give the
handle, type, and link bool) should have been fetched by a call to GetAttributeInfo.
The aTypeIs and aLinkIs attributes must be set using SetTypeAndLink, they are illegal here.
We check that the type of v corresponds to ft of attribute at this level, and in the case
of entity-valued attributes, check that v is of the right type with CompatibleDomain.
If fl=Unlinked, then we store the name of the entity rather than the entity itself.
If fl=Remote, we store the "segment: domain: name" as string instead of entity.
fl=Colocated not yet implemented, treated just like fl=Linked.
TRUSTED BEGIN
CheckNullified[t];
WITH v1: v SELECT FROM
public =>
WITH v2: v1.val
SELECT
FROM
integer =>
IF ft#IntType THEN ERROR DB.Error[MismatchedAttributeValueType]
ELSE DBStorage.Write2Word[t, fh, LOOPHOLE[v2.value]];
time =>
IF ft#TimeType THEN ERROR DB.Error[MismatchedAttributeValueType]
ELSE DBStorage.Write2Word[t, fh, BasicTime.ToPupTime[v2.value]];
rope =>
IF ft#RopeType THEN ERROR DB.Error[MismatchedAttributeValueType]
ELSE DBStorage.WriteVarByte[t, fh, v2.value];
boolean =>
IF ft#BoolType THEN ERROR DB.Error[MismatchedAttributeValueType]
ELSE DBStorage.Write1Word[t, fh,
LOOPHOLE[v2.value] ];
LOOPHOLE because Write1Word expects a CARDINAL.
entity => {
IF SameSegment[v2.value, t]
THEN
{
IF
NOT CompatibleDomain[GetCachedEntityInfo[SegmentOf[v2.value], v2.value].domain, ft]
THEN
ERROR DB.Error[MismatchedAttributeValueType]}
ELSE IF fl#Remote THEN ERROR DB.Error[MismatchedSegment];
Type of v is OK (except we can't check this for cross-segment refs)
IF fl=Linked
OR fl=Colocated
THEN
-- linked: store the entity reference in a group
BEGIN
temp: DBStorage.GroupScanHandle;
DBStorage.WriteTID[t, (temp← DBStorage.OpenScanGroup[v2.value, fh, Last])];
TID backpointer at end of group for the moment
DBStorage.CloseScanGroup[temp]
END
ELSE
IF fl=Unlinked
THEN
-- not linked: store name as string
SetValFromHandle[t, fh, RopeType, , S2PV[GetCachedEntityInfo[SegmentOf[v2.value], v2.value].name]]
ELSE
-- fl=Remote: store segment: domain: name
SetValFromHandle[t, fh, RopeType, , S2PV[EntityToID[v2.value]]];
};
null =>
IF ft=RopeType
THEN DBStorage.WriteVarByte[t, fh,
NIL]
ELSE
IF IsDomainType[ft]
THEN
IF fl=Linked OR fl=Colocated THEN DBStorage.WriteTIDNil[t, fh]
ELSE DBStorage.WriteVarByte[t, fh, NIL]
ELSE
-- give the guy another chance, construct a null value for him ...
SetValFromHandle[t, fh, ft, fl, [public[MakeNullValueOfType[ft]]]];
ENDCASE => DB.Error[IllegalValue];
handle =>
IF ft#RecordType
THEN
ERROR DB.Error[IllegalValue]
ELSE DBStorage.WriteNWord[t, fh, v1.val];
ENDCASE => DB.Error[IllegalValue];
END;
CompatibleDomain:
PROC [d: Domain, dt: DataType]
RETURNS [
BOOL] = {
Returns TRUE iff elements of datatype dt are compatible with domain d
IF QNullDomain[d] THEN ERROR DB.Error[IllegalDomain];
IF DBModelSchema.InvalidDomain[d] THEN ERROR DB.Error[InvalidSchema];
IF dt = AnyDomainType THEN RETURN[TRUE];
IF d.isSystem
THEN
SELECT d.name
FROM
"Domain" => RETURN[dt = $DomainDomain OR dt = $DataTypeDomain];
"Relation" => RETURN[dt = $RelationDomain];
"Attribute" => RETURN[dt = $AttributeDomain];
"DataType" => RETURN[dt = $DataTypeDomain];
"Index" => RETURN[dt = $IndexDomain];
"IndexFactorDomain" => RETURN[dt = $IndexFactorDomain];
ENDCASE => ERROR DB.Error[IllegalDomain];
IF Atom.MakeAtom[d.name] = dt THEN RETURN[TRUE];
Otherwise see if dt is compatible with d's SuperType
{ d1: Domain ← QSuperType[d];
IF
NOT QNullDomain[d1]
THEN
RETURN[CompatibleDomain[d1, dt]]
ELSE RETURN[FALSE] } };
GetTypeEntity:
PROC [t: TupleHandle]
RETURNS [typeEntity: Entity] =
BEGIN
a: Attribute;
IF IsSystem[t] THEN ERROR InternalError;
a ← DBModelSchema.TupleToAttribute[t];
RETURN[DataTypeToEntity[a.type, a.relation.segment]];
END;
CheckNullified:
PROC [p: TupleHandle] =
INLINE {
Use for Entities and Relships
IF p=NIL THEN ERROR DB.Error[NILArgument]
ELSE IF p.tid=NoTID THEN ERROR DB.Error[NullifiedArgument] };
IDToEntity:
PROC[name:
ROPE]
RETURNS[e: Entity] = {
Copied from Donahue's DBNamesImpl.mesa.
segNameLength: INT = Rope.Find[ name, ":" ];
domainNameLength: INT = Rope.Find[ name, ":", segNameLength+2 ] - segNameLength - 2;
segName: ROPE = Rope.Substr[ name, 0, segNameLength ];
domainName: ROPE = Rope.Substr[ name, segNameLength+2, domainNameLength ];
entityName: ROPE = Rope.Substr[ name, segNameLength+domainNameLength+4 ];
segment: Segment = Atom.MakeAtom[ segName ];
domain: Domain;
domain ← DBModel.QDeclareDomain[ domainName, segment, OldOnly !
DB.Error => TRUSTED {domain ← NIL; CONTINUE} ];
e ←
IF QNullDomain[domain]
THEN
NIL
ELSE FetchEntity[ domain, entityName ] };
EntityToID:
PROC[e: Entity]
RETURNS[name:
ROPE] = {
ename: ROPE; domain: Domain;
segment: SegmentHandle ← SegmentOf[e];
[ename, domain] ← GetCachedEntityInfo[segment, e];
RETURN[Rope.Cat[Atom.GetPName[segment.segment], ": ", domain.name, ": ", ename]] };
SameSegment:
PROC [x, y: DBStorage.TupleHandle]
RETURNS [
BOOL] =
INLINE {RETURN[DBStorage.SegmentIDFromTuple[x]=DBStorage.SegmentIDFromTuple[y]]};
SetMultipleF:
PROC[t: Relship, alh: PrivateAttributeValueList] =
Does NOT destroy or create any existing index entries, since used only by CreateRelship
and SurrogateCreateRelship. For same reason, no type checking necessary on t.
BEGIN
FOR alhT: PrivateAttributeValueList ← alh, alhT.rest
UNTIL alhT=
NIL
DO
QSetF[t, alhT.first.attribute, PV2V[alhT.first.lo], FALSE];
ENDLOOP
END;
PV2V:
PROC[v: PrivateValue]
RETURNS[Value] =
TRUSTED INLINE { RETURN[WITH v: v SELECT FROM public => v.val, ENDCASE => ERROR DB.Error[MismatchedValueType] ] };