<> <> <> <> <> <<>> 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.