CoreContextImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Louis Monier October 16, 1985 4:28:29 pm PDT
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;};
-- 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
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!
IF ~ok THEN ERROR; -- double registration?
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.