IPContextImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 30, 1985 6:02:19 pm PDT
DIRECTORY
Imager USING [DoSave, DoSaveAll],
IPInterpreter USING [Any, Array, ArrayFromVector, Bug, Context, ContextRep, Get, Integer, MasterError, Operator, OperatorClass, OperatorClassRep, OperatorRep, Pool, PoolRep, PushVector, Ref, Vector, VectorFromArray, ZeroVec];
IPContextImpl: CEDAR PROGRAM
IMPORTS Imager, IPInterpreter
EXPORTS IPInterpreter
~ BEGIN OPEN IPInterpreter;
Call:
PUBLIC
PROC[self: Ref, action:
PROC, frame: Vector, pool: Pool, env: Vector] ~ {
context: Context ~
NEW[ContextRep ← [
caller: self.context, marker: self.lastMarker+1, token: [],
initialFrame: frame, frame: NIL, pool: pool, env: env
]];
self.lastMarker ← context.marker;
self.context ← context;
action[! UNWIND => self.context ← context.caller];
IF self.context=context THEN self.context ← context.caller ELSE ERROR Bug;
};
Frame:
PUBLIC
PROC[self: Ref]
RETURNS[Vector] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN RETURN[context.initialFrame]
ELSE RETURN[VectorFromArray[context.frame]];
};
FGet:
PUBLIC
PROC[self: Ref, i: Integer]
RETURNS[Any] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN RETURN[Get[context.initialFrame, i]]
ELSE { array: Array ~ context.frame; RETURN[array[i-array.lowerBound]] };
};
FSet:
PUBLIC
PROC[self: Ref, x: Any, i: Integer] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN context.frame ← ArrayFromVector[context.initialFrame];
{ array: Array ~ context.frame; array[i-array.lowerBound] ← x };
};
PoolOp:
PUBLIC
PROC[self: Ref]
RETURNS[Pool] ~ {
context: Context ~ self.context;
RETURN[context.pool];
};
PGet:
PUBLIC
PROC[self: Ref, i: Integer]
RETURNS[Any] ~ {
context: Context ~ self.context;
array: Array ~ context.pool.array;
RETURN[array[i-array.lowerBound]];
};
PSet:
PUBLIC
PROC[self: Ref, x: Any, i: Integer] ~ {
context: Context ~ self.context;
array: Array ~ context.pool.array;
-- SavePool[self, pool, ...]; --
array[i-array.lowerBound] ← x;
};
Env:
PUBLIC
PROC[self: Ref]
RETURNS[Vector] ~ {
context: Context ~ self.context;
RETURN[context.env];
};
emptyVec: Vector ~ ZeroVec[0];
MakePool:
PUBLIC
PROC[v: Vector, persistent:
BOOL]
RETURNS[Pool] ~ {
RETURN[NEW[PoolRep ← [persistent: persistent, array: ArrayFromVector[v]]]];
};
noPool: Pool ~ MakePool[v: emptyVec, persistent:
FALSE];
NoPool:
PUBLIC
PROC
RETURNS[Pool] ~ {
RETURN[noPool] };
VectorFromPool:
PUBLIC
PROC[pool: Pool]
RETURNS[Vector] ~ {
RETURN[VectorFromArray[pool.array]];
};
DoSave:
PUBLIC
PROC[self: Ref, action:
PROC] ~ {
Eventually, this should worry about pools other than the Imager pool
showVec: Vector ~ self.showVec;
Imager.DoSave[self.imager, action ! UNWIND => self.showVec ← showVec];
self.showVec ← showVec;
};
DoSaveAll:
PUBLIC
PROC[self: Ref, action:
PROC] ~ {
Eventually, this should worry about pools other than the Imager pool
showVec: Vector ~ self.showVec;
Imager.DoSaveAll[self.imager, action ! UNWIND => self.showVec ← showVec];
self.showVec ← showVec;
};
poolClass: OperatorClass ~
NEW[OperatorClassRep ← [type: $Pool, do: PoolDo]];
PoolDo:
PROC[op: Operator, state: Ref] ~ {
pool: Pool ~ NARROW[op.data];
PushVector[state, VectorFromPool[pool]];
};
OperatorFromPool:
PUBLIC
PROC[pool: Pool]
RETURNS[Operator] ~ {
RETURN[NEW[OperatorRep ← [class: poolClass, data: pool]]];
};
PoolFromOperator:
PUBLIC
PROC[op: Operator]
RETURNS[Pool] ~ {
IF NOT op.class.type=$Pool THEN MasterError[$wrongType, "Operator is not a Pool"];
WITH op.data SELECT FROM pool: Pool => RETURN[pool]; ENDCASE => ERROR Bug;
};
END.