DIRECTORY Core, CoreContext, CoreOps, Properties, Rope, RefTab; CoreContextImpl: CEDAR PROGRAM IMPORTS RefTab EXPORTS CoreContext = BEGIN OPEN CoreContext; ref: ATOM =$CtxREF; atom: ATOM =$CtxATOM; rope: ATOM =$CtxROPE; int: ATOM =$CtxINT; real: ATOM =$CtxREAL; stMark: ATOM =$CtxStackMark; procMark: ATOM =$CtxprocMark; CheckType: PROC [prop, type: ATOM] RETURNS [ok: BOOL] = { ok _ RefTab.Fetch[propTable, prop].val=type;}; GetRef: PUBLIC PROC [context: Context, prop: ATOM] RETURNS [REF] = { FOR l: Context _ context, l.rest WHILE l#NIL DO IF l.first.key=prop THEN RETURN[l.first.val]; ENDLOOP; ERROR; -- prop not found }; GetAtom: PUBLIC PROC [context: Context, prop: ATOM] RETURNS [ATOM] = { IF ~CheckType[prop, atom] THEN ERROR; -- prop was registered for another type RETURN[NARROW[GetRef[context, prop]]];}; GetRope: PUBLIC PROC [context: Context, prop: ATOM] RETURNS [ROPE] = { IF ~CheckType[prop, rope] THEN ERROR; -- prop was registered for another type RETURN[NARROW[GetRef[context, prop]]];}; GetInt: PUBLIC PROC [context: Context, prop: ATOM] RETURNS [INT] = { IF ~CheckType[prop, int] THEN ERROR; -- prop was registered for another type RETURN[NARROW[GetRef[context, prop], REF INT]^];}; GetReal: PUBLIC PROC [context: Context, prop: ATOM] RETURNS [REAL] = { IF ~CheckType[prop, real] THEN ERROR; -- prop was registered for another type RETURN[NARROW[GetRef[context, prop], REF REAL]^];}; PushRef: PUBLIC PROC [context: Context, prop: ATOM, val: REF] = { context _ CONS[[prop, val], context];}; PushAtom: PUBLIC PROC [context: Context, prop: ATOM, val: ATOM] = { context _ CONS[[prop, val], context];}; PushRope: PUBLIC PROC [context: Context, prop: ATOM, val: ROPE] = { context _ CONS[[prop, val], context];}; PushInt: PUBLIC PROC [context: Context, prop: ATOM, val: INT] = { context _ CONS[[prop, NEW[INT _ val]], context];}; PushReal: PUBLIC PROC [context: Context, prop: ATOM, val: REAL] = { context _ CONS[[prop, NEW[REAL _ val]], context];}; RegisterRefProperty: PUBLIC PROC [prop: ATOM] = { [] _ RefTab.Store[propTable, prop, ref]}; -- why register? RegisterAtomProperty: PUBLIC PROC [prop: ATOM] = { [] _ RefTab.Store[propTable, prop, atom]}; -- why register? RegisterRopeProperty: PUBLIC PROC [prop: ATOM] = { [] _ RefTab.Store[propTable, prop, rope]}; -- why register? RegisterIntProperty: PUBLIC PROC [prop: ATOM] = { [] _ RefTab.Store[propTable, prop, $INT]}; -- why register? RegisterRealProperty: PUBLIC PROC [prop: ATOM] = { [] _ RefTab.Store[propTable, prop, real]}; -- why register? CreateContext: PUBLIC PROC [init: Context _ NIL, props: PropertyLiterals] RETURNS [Context] = { new: Context _ init; FOR l: PropertyLiterals _ props, l.rest WHILE l#NIL DO new _ CONS[l.first, new]; ENDLOOP; RETURN[new]; }; MarkContext: PUBLIC PROC [context: Context, mark: ATOM] = { PushAtom[context, stMark, mark];}; PopContext: PUBLIC PROC [context: Context, mark: ATOM] = { FOR l: Context _ context, l.rest WHILE l#NIL DO IF l.first.key=stMark AND l.first.val=mark THEN {context _ l.rest; RETURN}; ENDLOOP; ERROR; -- mark not found }; RegisterStructureProc: PUBLIC PROC [name: ROPE, proc: StructureProc] RETURNS [ROPE] = { val: REF StructureProc _ NEW[StructureProc _ proc]; ok: BOOL _ RefTab.Store[structProcTable, name, val]; -- larger table! RETURN[name]}; CreateStructure: PUBLIC PROC [name: ROPE, context: Context] RETURNS [ct: Core.CellType] = { proc: StructureProc _ NARROW[RefTab.Fetch[structProcTable, name].val, REF StructureProc]^; MarkContext[context, procMark]; ct _ proc[context]; -- what about the stack? PopContext[context, procMark]; }; propTable: RefTab.Ref _ RefTab.Create[]; structProcTable: RefTab.Ref _ RefTab.Create[]; END. €CoreContextImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Louis Monier October 16, 1985 4:28:29 pm PDT -- These procs are different from the ones in Properties.mesa because the order matters; -- the properties are older as we move towards the end of the list -- and this is how the scoping mechanism works IF ~ok THEN ERROR; -- double registration? Κ.– "cedar" style˜codešœ™Kšœ Οmœ1™