IPOperatorImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, August 20, 1984 1:20:50 pm PDT
IPOperatorImpl: CEDAR PROGRAM
IMPORTS Imager, IP
EXPORTS IP
~ BEGIN OPEN IP;
NewMarker:
PROC[self: State]
RETURNS[Marker] ~ {
last: Marker ~ self.lastMarker;
IF last<Marker.LAST THEN RETURN[self.lastMarker ← last+1]
ELSE ERROR Bug["Ran out of Marker values!"];
};
Call:
PUBLIC
PROC[self: State, action:
PROC, frame: Vector, pool: Pool, env: Vector] ~ {
caller: Context ~ self.context;
marker: Marker ~ NewMarker[self]; -- generate a unique mark
context: Context ~
NEW[ContextRep ← [
-- create a new context
caller: caller, marker: marker,
frame: NIL, initialFrame: frame, pool: pool, env: env
]];
self.context ← context;
action[! UNWIND => self.context ← caller];
self.context ← caller;
};
Frame:
PUBLIC
PROC[self: State]
RETURNS[Vector] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN RETURN[context.initialFrame]
ELSE RETURN[VectorFromArray[ACopy[context.frame]]];
};
FGet:
PUBLIC
PROC[self: State, j: Integer]
RETURNS[Any] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN RETURN[Get[context.initialFrame, j]]
ELSE RETURN[AGet[context.frame, j]]
};
FSet:
PUBLIC
PROC[self: State, x: Any, j: Integer] ~ {
context: Context ~ self.context;
IF context.frame=NIL THEN context.frame ← ArrayFromVector[context.initialFrame];
ASet[context.frame, x, j];
};
PoolOp:
PUBLIC
PROC[self: State]
RETURNS[Pool] ~ {
RETURN[self.context.pool] };
PGet:
PUBLIC
PROC[self: State, j: Integer]
RETURNS[Any] ~ {
pool: Pool ~ self.context.pool;
RETURN[AGet[pool.array, j]];
};
PSet:
PUBLIC
PROC[self: State, x: Any, j: Integer] ~ {
pool: Pool ~ self.context.pool;
-- SavePool[self, pool, ...]; --
ASet[pool.array, x, j];
};
Env:
PUBLIC
PROC[self: State]
RETURNS[Vector] ~ {
RETURN[self.context.env];
};
MakePool:
PUBLIC
PROC[v: Vector, persistent:
BOOL]
RETURNS[Pool] ~ {
RETURN[NEW[PoolRep ← [persistent: persistent, array: ArrayFromVector[v]]]];
};
noPool: Pool ~ MakePool[v: NullVector[shape: [l: 0, n: 0]], persistent: FALSE];
NoPool: PUBLIC PROC RETURNS[Pool] ~ { RETURN[noPool] };
PoolValue:
PUBLIC
PROC[pool: Pool]
RETURNS[Vector] ~ {
RETURN[VectorFromArray[pool.array]];
};
poolClass: OperatorClass ~ NEW[OperatorClassRep ← [type: $Pool, apply: PoolApply]];
PoolApply:
PROC[op: Operator, state: State] ~ {
PushVector[state, PoolValue[op.pool]];
};
OperatorFromPool:
PUBLIC
PROC[pool: Pool]
RETURNS[Operator] ~ {
RETURN[NEW[OperatorRep ← [class: poolClass, data: NIL, pool: pool]]];
};
PoolFromOperator:
PUBLIC
PROC[op: Operator]
RETURNS[Pool] ~ {
IF op.pool#NIL THEN RETURN[op.pool]
ELSE {
MasterError[$wrongType, "Operator is not a Pool."];
ERROR Error;
};
};
DoWithSaveEffect:
PUBLIC
PROC[self: State, action:
PROC, saveEffect: SaveEffect] ~ {
Eventually, this should worry about pools other than the Imager pool
IF saveEffect=$nil THEN action[]
ELSE {
showVec: Vector ~ self.showVec;
mediumSize: VEC ~ self.mediumSize;
fieldMin: VEC ~ self.fieldMin;
fieldMax: VEC ~ self.fieldMax;
Restore:
PROC ~ {
self.showVec ← showVec;
self.mediumSize ← mediumSize;
self.fieldMin ← fieldMin;
self.fieldMax ← fieldMax;
};
SELECT saveEffect
FROM
$nil => action[];
$save => { self.imager.DoSave[action ! UNWIND => Restore[]]; Restore[] };
$saveAll => { self.imager.DoSaveAll[action ! UNWIND => Restore[]]; Restore[] };
ENDCASE => ERROR;
};
};
coClass: OperatorClass ~ NEW[OperatorClassRep ← [type: $CO, apply: COApply]];
COData: TYPE ~ REF CODataRep;
CODataRep:
TYPE ~
RECORD[
frame: Vector, -- initial frame
pool: Pool, -- shared pool
env: Vector, -- environment
body: Index -- starting index of body
];
COApply:
PROC[op: Operator, state: State] ~ {
data: COData ~ NARROW[op.data];
body: PROC ~ { ExecuteBody[state, data.body] };
Call[self: state, action: body, frame: data.frame, pool: data.pool, env: data.env];
};
MakeCO:
PUBLIC
PROC[self: State, pool: Pool, f: Vector]
RETURNS[Operator] ~ {
body: Index ~ ReadNextBody[self];
data: COData ~ NEW[CODataRep ← [frame: f, pool: pool, env: Env[self], body: body]];
RETURN[NEW[OperatorRep ← [class: coClass, data: data]]];
};
MakeSimpleCO:
PUBLIC
PROC[self: State]
RETURNS[Operator] ~ {
RETURN[MakeCO[self: self, pool: noPool, f: Frame[self]]];
};
compiledImageClass: OperatorClass ~
NEW[OperatorClassRep ← [
type: $CompiledImage, apply: CompiledImageApply]];
CompiledImageData: TYPE ~ REF CompiledImageDataRep;
CompiledImageDataRep:
TYPE ~
RECORD[f: Vector, env: Vector, body: Index];
CompiledImageApply:
PROC[op: Operator, state: State] ~ {
data: CompiledImageData ~ NARROW[op.data];
body: PROC ~ { ExecuteBody[state, data.body] };
Call[self: state, action: body, frame: data.f, pool: NoPool[], env: data.env];
};
MakeCompiledImage:
PUBLIC
PROC[self: State, f: Vector]
RETURNS[Operator] ~ {
body: Index ~ ReadNextBody[self];
data: CompiledImageData ~ NEW[CompiledImageDataRep ← [f: f, env: Env[self], body: body]];
RETURN[NEW[OperatorRep ← [class: compiledImageClass, data: data]]];
};
Do:
PUBLIC
PROC[self: State, o: Operator, saveEffect: SaveEffect ← $nil] ~ {
action: PROC ~ { o.class.apply[o, self] };
DoWithSaveEffect[self, action, saveEffect];
};
DoBody:
PUBLIC
PROC[self: State, pool: Pool, f: Vector, saveEffect: SaveEffect ← $nil] ~ {
nextBody: PROC ~ { ExecuteNextBody[self] };
action: PROC ~ { Call[self: self, action: nextBody, frame: f, pool: pool, env: Env[self]] };
DoWithSaveEffect[self, action, saveEffect];
};
DoSimpleBody:
PUBLIC
PROC[self: State, saveEffect: SaveEffect ← $nil] ~ {
DoBody[self, noPool, Frame[self], saveEffect];
};
END.