DIRECTORY Convert, GGSlice, GGParent, GGProps, GGSliceOps, IO, Prop, Real, RefTab, Rope; GGPropsImpl: CEDAR MONITOR IMPORTS Convert, GGParent, GGSliceOps, IO, Prop, RefTab EXPORTS GGProps = BEGIN STREAM: TYPE = IO.STREAM; Slice: TYPE = GGSlice.Slice; SliceDescriptor: TYPE = GGSlice.SliceDescriptor; SliceParts: TYPE = GGSlice.SliceParts; PropList: TYPE = Prop.PropList; PropWalkProc: TYPE = GGProps.PropWalkProc; FileoutProc: TYPE = GGProps.FileoutProc; FileinProc: TYPE = GGProps.FileinProc; CopyProc: TYPE = GGProps.CopyProc; ValFormat: TYPE = GGProps.ValFormat; Put: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM, val: REF] = { DoPut: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL _ FALSE] = { sliceD.slice.props _ Prop.Put[sliceD.slice.props, key, val]; }; IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] _ GGParent.WalkIncludedChildren[slice, parts, leaf, DoPut] ELSE slice.props _ Prop.Put[slice.props, key, val]; }; PutAll: PROC [slice: Slice, parts: SliceParts, props: Prop.PropList] = { DoPut: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL _ FALSE] = { sliceD.slice.props _ props; }; IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] _ GGParent.WalkIncludedChildren[slice, parts, leaf, DoPut] ELSE slice.props _ props; }; Get: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM] RETURNS [val: REF, isUnique: BOOL _ TRUE] = { found: BOOL _ FALSE; DoGet: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL _ FALSE] = { thisVal: REF _ Prop.Get[sliceD.slice.props, key]; -- returns NIL if not found IF thisVal#NIL THEN { -- check the property for uniqueness IF found AND thisVal#val THEN RETURN[TRUE] ELSE { val _ thisVal; -- first found property found _ TRUE; }; }; }; IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN isUnique _ NOT GGParent.WalkIncludedChildren[slice, parts, leaf, DoGet] ELSE val _ Prop.Get[slice.props, key]; }; Rem: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM] RETURNS [isUnique: BOOL _ TRUE] = { val: REF; found: BOOL _ FALSE; DoRem: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL _ FALSE] = { thisVal: REF _ Prop.Get[sliceD.slice.props, key]; -- returns NIL if not found IF thisVal#NIL THEN { sliceD.slice.props _ Prop.Rem[sliceD.slice.props, key]; -- remove the property IF found AND thisVal#val THEN isUnique _ FALSE -- check the property for uniqueness ELSE { val _ thisVal; -- first found property found _ TRUE; }; }; }; IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] _ GGParent.WalkIncludedChildren[slice, parts, leaf, DoRem] ELSE slice.props _ Prop.Rem[slice.props, key]; }; Copy: PUBLIC PROC [key: ATOM, val: REF] RETURNS [copy: REF] = { tableEntry: REF; gtEntry: GTEntry; found: BOOL _ FALSE; [found, tableEntry] _ RefTab.Fetch[gt, key]; IF found THEN { gtEntry _ NARROW[tableEntry]; IF gtEntry.copy=NIL THEN copy _ val ELSE copy _ gtEntry.copy[val]; } ELSE copy _ val; }; Walk: PUBLIC PROC [slice: Slice, parts: SliceParts, walkProc: PropWalkProc] RETURNS [aborted: BOOL _ FALSE] = { DoMap: Prop.MapAction = { RETURN[walkProc[NARROW[key], val]]; }; DoWalk: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL _ FALSE] = { done _ Prop.Map[sliceD.slice.props, DoMap]; }; IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN aborted _ GGParent.WalkIncludedChildren[slice, parts, leaf, DoWalk] ELSE aborted _ Prop.Map[slice.props, DoMap] }; Kill: PUBLIC PROC [slice: Slice, parts: SliceParts] = { DoKill: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL _ FALSE] = { sliceD.slice.props _ NIL; }; IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] _ GGParent.WalkIncludedChildren[slice, parts, leaf, DoKill] ELSE slice.props _ NIL; }; CopyAll: PUBLIC PROC [fromSlice, toSlice: Slice, fromParts, toParts: SliceParts _ NIL] = { DoCopyProc: PropWalkProc = { copyProps _ Prop.Put[copyProps, key, Copy[key, val]]; }; copyProps: Prop.PropList _ NIL; [] _ Walk[fromSlice, fromParts, DoCopyProc]; PutAll[toSlice, toParts, copyProps]; }; ToRope: PUBLIC ENTRY PROC [key: ATOM, val: REF] RETURNS [r: Rope.ROPE, vf: ValFormat _ delimited] = { ENABLE UNWIND => NULL; -- releases monitor locks if aborted found: BOOL _ FALSE; tableEntry: REF; gtEntry: GTEntry; [found, tableEntry] _ RefTab.Fetch[gt, key]; IF NOT found OR tableEntry=NIL THEN { WITH val SELECT FROM a: ATOM => RETURN[Convert.RopeFromAtom[from: a]]; rope: Rope.ROPE => RETURN[rope]; int: REF INT => RETURN[Convert.RopeFromInt[from: int^, base: 10, showRadix: FALSE]]; card: REF CARD => RETURN[Convert.RopeFromCard[from: card^, base: 10, showRadix: FALSE]]; real: REF REAL => RETURN[Convert.RopeFromReal[from: real^, precision: Real.MaxSinglePrecision, useE: FALSE]]; bool: REF BOOL => RETURN[Convert.RopeFromBool[from: bool^]]; ENDCASE => RETURN[NIL]; } ELSE { gtEntry _ NARROW[tableEntry]; IF gtEntry.out=NIL THEN RETURN[NIL]; -- will implement generic output later vf _ gtEntry.out[IO.ROS[oldStream: scratchROS], val]; -- fill the stream with a description of val r _ IO.RopeFromROS[self: scratchROS, close: TRUE]; }; }; FromRope: PUBLIC ENTRY PROC [key: ATOM, r: Rope.ROPE] RETURNS [val: REF] = { ENABLE UNWIND => NULL; -- releases monitor locks if aborted found: BOOL _ FALSE; tableEntry: REF; gtEntry: GTEntry; [found, tableEntry] _ RefTab.Fetch[gt, key]; IF NOT found OR tableEntry=NIL THEN { tokenKind: IO.TokenKind; token: Rope.ROPE; charsSkipped: INT; success: BOOL _ TRUE; s: IO.STREAM _ IO.RIS[rope: r, oldStream: scratchRIS]; [tokenKind, token, charsSkipped] _ IO.GetCedarTokenRope[s ! IO.EndOfStream, IO.Error => {success _ FALSE; CONTINUE}]; IF NOT success THEN ERROR; IF IO.EndOf[s] THEN { -- value consists of a single token SELECT tokenKind FROM tokenID => val _ token; tokenDECIMAL => val _ NEW[INT _ Convert.IntFromRope[token, 10]]; tokenOCTAL => val _ NEW[INT _ Convert.IntFromRope[token, 8]]; tokenHEX => val _ NEW[INT _ Convert.IntFromRope[token, 16]]; tokenREAL => val _ NEW[REAL _ Convert.RealFromRope[token]]; tokenROPE => val _ Convert.RopeFromLiteral[token]; tokenCHAR => val _ token; tokenATOM => val _ Convert.AtomFromRope[token]; ENDCASE => val _ token; } ELSE { -- if there are multiple tokens, return the whole rope val _ r; }; } ELSE { gtEntry _ NARROW[tableEntry]; IF gtEntry.in=NIL THEN RETURN[r]; val _ gtEntry.in[IO.RIS[rope: r, oldStream: scratchRIS]]; }; }; Register: PUBLIC PROC [key: ATOM, in: FileinProc, out: FileoutProc, copy: CopyProc] = { gtEntry: GTEntry _ NEW[GTEntryRep _ [in, out, copy] ]; [] _ RefTab.Store[gt, key, gtEntry]; -- overwrites earlier entries with same key }; Init: PROC = { bigRope: Rope.ROPE _ "BeKindToYourWebFootedFriendsForADuckMayBeSomebodysMother"; gt _ RefTab.Create[]; scratchRIS _ IO.RIS[rope: bigRope]; scratchROS _ IO.ROS[]; }; IdentityCopy: PUBLIC CopyProc = { copy _ val; }; RegisterTestProcs: PROC = { Register[$int, FileInInt, FileOutInt, IdentityCopy]; Register[$real, FileInReal, FileOutReal, IdentityCopy]; Register[$atom, FileInAtom, FileOutAtom, IdentityCopy]; }; FileInInt: FileinProc = { ref: REF INT _ NEW[INT]; ref^ _ IO.GetInt[s]; val _ ref; }; FileOutInt: FileoutProc = { ref: REF INT _ NARROW[val]; s.Put[ [integer[ref^]] ]; }; FileInReal: FileinProc = { ref: REF REAL _ NEW[REAL]; ref^ _ IO.GetReal[s]; val _ ref; }; FileOutReal: FileoutProc = { ref: REF REAL _ NARROW[val]; s.Put[ [real[ref^]] ]; }; FileInAtom: FileinProc = { ref: ATOM _ IO.GetAtom[s]; val _ ref; }; FileOutAtom: FileoutProc = { ref: ATOM _ NARROW[val]; s.Put[ [atom[ref]] ]; }; FileInRope: FileinProc = { ref: Rope.ROPE _ IO.GetRope[s]; val _ ref; }; FileOutRope: FileoutProc = { ref: Rope.ROPE _ NARROW[val]; s.PutRope[ref]; }; GTEntry: TYPE = REF GTEntryRep; GTEntryRep: TYPE = RECORD [in: FileinProc, out: FileoutProc, copy: CopyProc]; gt: RefTab.Ref; scratchRIS: STREAM; scratchROS: STREAM; Init[]; RegisterTestProcs[]; END. ϊGGPropsImpl.mesa Copyright Σ 1989 by Xerox Corporation. All rights reserved. Last edited by Pier on June 16, 1989 10:14:28 am PDT Contents: General property mechanism for GG slices Bier, July 17, 1989 5:09:16 pm PDT Add the given property to the children of slice described in parts. Add the given property to the children of slice described in parts. Get the property value matching key from the children of slice described in parts. If the children have more than one value for this property, return one of the values and isUnique = FALSE Remove the property value matching key from the children of slice described in parts. If the children have more than one different value for this property, return isUnique = FALSE For all properties of the children of slice described in parts, call the walkProc. Returns aborted=TRUE and aborts the walk if any call to walkProc returned TRUE. Remove all the properties of the children of slice described in parts PROC [key: ATOM, val: REF] RETURNS [done: BOOL _ FALSE]; Returns a ROPE describing the property value and the encoding format of that ROPE. Uses a single scratch stream, so needs to be an ENTRY PROC. Returns r=NIL if cannot encode val. Returns a property derived from the input ROPE. Uses a single scratch stream, so needs to be an ENTRY PROC. Returns r if cannot decode r. A global table of [key, fileinProc, fileoutProc] entries is maintained. Clients who wish to have their properties filed in and out are encouraged to register appropriate procs. Κ y˜codešœ™K™˜vKšžœ/˜3K˜K™—šœžœ<˜HK™Cš œžœžœžœžœ˜FJšœ˜J˜—Kšžœ2žœ>˜vKšžœ˜K˜K™—šΠbnœž œ(žœžœžœ žœžœ˜kKšœΈž™½Kšœžœžœ˜š œžœžœžœžœ˜FKšœ žœΟbœ#Οc˜Mšžœ žœžœ‘$˜:Jš žœžœ žœžœžœ˜*šžœ˜Jšœ‘˜&Jšœžœ˜ J˜—J˜—J˜J˜—šžœ2ž˜8Kšœ žœ- œ˜G—Kšžœ"˜&K˜K™—š œž œ(žœžœ žœžœ˜aKšœ―ž™΄Kšœžœ˜ Kšœžœžœ˜š œžœžœžœžœ˜FKšœ žœ œ#‘˜Mšžœ žœžœ˜Jšœ8‘˜NJš žœžœ žœ žœ‘$˜Sšžœ˜Jšœ‘˜&Jšœžœ˜ J˜—J˜—J˜J˜—šžœ2ž˜8Kšœ1 œ˜=—Kšžœ*˜.K˜K™—šœžœžœžœžœžœžœ˜?Kšœ žœ˜Kšœ˜Kšœžœžœ˜K˜Kšœ,˜,šžœžœ˜Kšœ žœ ˜Kšžœžœžœ ˜#Kšžœ˜K˜—Kšžœ ˜K˜K˜—š Ÿœžœžœ;žœ žœžœ˜oKšœdžœ6žœ™£šœ˜Kšžœ žœ ˜#K˜—š œžœžœžœžœ˜GK˜+K˜K˜—šžœ2ž˜8Kšœ6 œ ˜C—Kšžœ'˜+K˜K™—šŸœžœžœ&˜7KšœE™Eš Ÿœžœžœžœžœ˜GKšœžœ˜K˜K˜—šžœ2ž˜8Kšœ1 œ ˜>—Kšžœžœ˜K˜—K˜šœžœžœ>žœ˜Zš œ ˜Kš žœžœžœžœžœžœ™8Kšœ5˜5K˜—Kšœžœ˜Kšœ,˜,Kšœ$˜$K˜K˜—šŸœžœžœžœžœžœžœ žœ ˜eKšœ žœ?žœ3žœ+™΄Kšžœžœžœ‘$˜;Kšœžœžœ˜Kšœ žœ˜Kšœ˜Kšœ,˜,š žœžœžœ žœžœ˜%šžœžœž˜Kšœžœžœ ˜1Kšœ žœžœ˜ Kš œžœžœžœ6žœ˜TKš œžœžœžœ8žœ˜XKš œžœžœžœMžœ˜mKšœžœžœžœ$˜˜PK˜K–)[rope: ROPE, oldStream: STREAM _ NIL]šœ žœžœ˜#K–ldStream: STREAM _ NIL]šœ žœžœ˜K˜K˜—š œžœ ˜!K˜ K˜K˜—šœžœ˜K˜4K˜7K˜7K˜K˜—š œ˜Kš œžœžœžœžœ˜K–[stream: STREAM]šœžœ ˜K˜ Kšœ˜—šΠntœ˜Kšœžœžœžœ˜K˜Kšœ˜—š’œ˜Kš œžœžœžœžœ˜K–[stream: STREAM]šœžœ ˜K˜ Kšœ˜—š’œ˜Kšœžœžœžœ˜K˜Kšœ˜—š’œ˜K–[stream: STREAM]šœžœžœ ˜K˜ Kšœ˜—š’œ˜Kšœžœžœ˜K˜Kšœ˜—š’œ˜K–[stream: STREAM]šœ žœžœ ˜K˜ Kšœ˜—š’œ˜Kšœ žœžœ˜Kšœ˜Kšœ˜—K˜Kšœ žœžœ ˜Kšœ žœžœ4˜MK˜Kšœ žœ˜Kšœ žœ˜K˜K˜K˜K˜Kšžœ˜—…—v0ι