<> <> <> <> <> <> <> <> <> <> <<1. Data types and globals>> <<2. Creating and destroying entities and relationships>> <<3. Getting and setting names and attributes>> <<4. Miscellaneous exported procedures>> <<5. Miscellaneous support routines>> DIRECTORY Atom USING [GetPName, MakeAtom], BasicTime, DBCommon, DBStats USING [Inc, Starting, Stopping], DBStorage, DBDefs, DB, DBModel, DBModelPrivate, DBModelSchema, IO, Rope; DBModelBasicImpl: CEDAR PROGRAM IMPORTS Atom, BasicTime, DBStats, DBStorage, DB, DBModel, DBDefs, DBModelPrivate, DBModelSchema, IO, Rope EXPORTS DB, -- Eq, Null, etc. DBModel, -- "Q" procedures DBModelPrivate = -- surrogate relship procs and GetTypeProp BEGIN OPEN DB, DBCommon, DBDefs, DBModel, DBModelPrivate; fakeTransAbort: BOOL_ FALSE; <> ROPE: TYPE = Rope.ROPE; <<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] = <> <> <> <> 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] = <> <> 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] = <> <> 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 => <> 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; <> 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] }; END; QDestroyEntity: PUBLIC PROC[e: Entity] = <> <<(1) deleting all references to it in indexes and groups,>> <<(2) calling the storage level to destroy the tuple itself, its TH,>> <> 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] = <> <> <> 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] = <> <> 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] = <> <> <> 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] = <> <> <> BEGIN t: SurrogateRelshipHandle; DBStats.Inc[SurrogateCreateRelship]; t_ NEW[DBDefs.SurrogateRelshipObject]; t.relation_ r; t.targetAttribute_ GetFirstAttribute[r]; <> IF init#NIL THEN SetMultipleF[t, init]; RETURN[t] END; QDestroyRelship: PUBLIC PROC[t: Relship] = <> <<(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,>> <> <> <> <> 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] = <> <> <> <> 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 <> <> QSetF[t, a, [null[]], FALSE ! DB.InternalError => TRUSTED {IF desperate THEN CONTINUE}]; ENDLOOP; END; SurrogateDestroyRelship: PROC[t: Relship] = <> <> 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 <> 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]; END; NameOf: PUBLIC PROC [e: Entity, domain: Domain] RETURNS [name: ROPE] = <> 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] = <> <> 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] = <> 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 <> 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] = <> <> <> <> <> <> 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 <> RETURN[V2S[QGetF[t, a, TRUE]]] ELSE <> 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] = <> 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 { <> v: Value _ DB.E2V[t.entity]; DBStats.Stopping[SurrogateGetF]; RETURN[v] } ELSE <> 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] = <> <<"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 <> 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> 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] = { <> <> QSetF[t, a, StringToValue[v, a]] }; SurrogateSetF: PROC [t: SurrogateRelshipHandle, a: Attribute, v: PrivateValue] = <> <> TRUSTED BEGIN DBStats.Starting[SurrogateSetF]; IF QAttributeEq[a, t.targetAttribute] THEN { v1: Value _ PV2V[v]; <> WITH v1 SELECT FROM null => IF t.entity#NIL THEN ERROR DB.Error[NotImplemented] -- Can't reset target if relation is surrogate ELSE t.entity_ V2E[v1]; 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 <> <> <> 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] = <> <> <> <<(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 => { <> <> 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] = <> <> <> <> <> <> <> <> 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] ]; <> 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]; <> 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])]; <> 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] = { <> 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]; <> { 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 { <> 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] = { <> 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] = <> <> 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] ] }; END.