<<>> <> <> <> <> <> <> <<>> 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.Put1[ [integer[ref]] ]; }; FileInReal: FileinProc = { ref: REF REAL Ź NEW[REAL]; ref Ź IO.GetReal[s]; val Ź ref; }; FileOutReal: FileoutProc = { ref: REF REAL Ź NARROW[val]; s.Put1[ [real[ref]] ]; }; FileInAtom: FileinProc = { ref: ATOM Ź IO.GetAtom[s]; val Ź ref; }; FileOutAtom: FileoutProc = { ref: ATOM Ź NARROW[val]; s.Put1[ [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.