TJaMStackImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, March 26, 1985 10:10:19 am PST
DIRECTORY
Rope USING [NewText],
TJaM,
TJaMPrivate;
TJaMStackImpl: CEDAR PROGRAM
IMPORTS Rope, TJaM
EXPORTS TJaM, TJaMPrivate
~ BEGIN OPEN TJaM, TJaMPrivate;
FrameImplRep: PUBLIC TYPE ~ TJaMPrivate.FrameImplRep;
NewStack:
PUBLIC
PROC [size:
NAT]
RETURNS [Stack] ~ {
stack: Stack ~ NEW[StackRep[size] ← [count: 0, max: 0, seq: ]];
RETURN[stack];
};
Push:
PUBLIC
PROC [frame: Frame, val: Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count<stack.size THEN ProduceError[stackOverflow];
IF val=NIL THEN ProduceError[invalidArgs];
stack[stack.count].ref ← val;
stack.count ← stack.count+1;
IF stack.count>stack.max THEN stack.max ← stack.count;
};
PushNum:
PUBLIC
PROC [frame: Frame, val: NumberRep] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count<stack.size THEN ProduceError[stackOverflow];
IF stack[stack.count].ref#NIL THEN ERROR;
TRUSTED{stack[stack.count].num ← val};
stack.count ← stack.count+1;
IF stack.count>stack.max THEN stack.max ← stack.count;
};
PushInt:
PUBLIC
PROC [frame: Frame, val:
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
num: NumberRep ~ [int[val]];
IF stack.count<stack.size
AND stack[stack.count].ref=
NIL
THEN {
TRUSTED{stack[stack.count].num ← num};
stack.count ← stack.count+1;
IF stack.count>stack.max THEN stack.max ← stack.count;
}
ELSE PushNum[frame, num];
};
PushBool:
PUBLIC
PROC [frame: Frame, val:
BOOL] ~ {
PushInt[frame, IF val THEN 1 ELSE 0];
};
PushReal:
PUBLIC
PROC [frame: Frame, val:
REAL] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
num: NumberRep ~ [real[val]];
IF stack.count<stack.size
AND stack[stack.count].ref=
NIL
THEN {
TRUSTED{stack[stack.count].num ← num};
stack.count ← stack.count+1;
IF stack.count>stack.max THEN stack.max ← stack.count;
}
ELSE PushNum[frame, num];
};
PushAtom:
PUBLIC
PROC [frame: Frame, val:
ATOM] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
emptyRope:
ROPE ~ Rope.NewText[0];
PushRope:
PUBLIC
PROC [frame: Frame, val:
ROPE] ~ {
rope: ROPE ~ IF val=NIL THEN emptyRope ELSE val; -- be sure to retain its type
Push[frame, rope];
};
PushStream:
PUBLIC
PROC [frame: Frame, val:
STREAM] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushCmd:
PUBLIC
PROC [frame: Frame, val: Cmd] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushArray:
PUBLIC
PROC [frame: Frame, val: Array] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushDict:
PUBLIC
PROC [frame: Frame, val: Dict] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushMark:
PUBLIC
PROC [frame: Frame, val: Mark] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
Pop:
PUBLIC
PROC [frame: Frame]
RETURNS [Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ← stack.count-1;
ref ← stack[stack.count].ref;
IF ref=NIL THEN RETURN[NEW[NumberRep ← stack[stack.count].num]]
ELSE { stack[stack.count].ref ← NIL; RETURN[ref] };
};
Remove:
PROC [frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ← stack.count-1;
IF stack[stack.count].ref#NIL THEN stack[stack.count].ref ← NIL;
};
PopNum:
PUBLIC
PROC [frame: Frame]
RETURNS [NumberRep] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ← stack.count-1;
ref ← stack[stack.count].ref;
IF ref=NIL THEN RETURN[stack[stack.count].num]
ELSE { stack[stack.count].ref ← NIL; RETURN[NumberFromAny[ref]^] };
};
PopInt:
PUBLIC
PROC [frame: Frame]
RETURNS [
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ← stack.count-1;
ref ← stack[stack.count].ref;
IF ref=
NIL
THEN {
n: NumberRep ~ stack[stack.count].num;
WITH n: n
SELECT
FROM
int => RETURN[n.int];
ENDCASE => RETURN[IntFromNum[n]];
}
ELSE { stack[stack.count].ref ← NIL; RETURN[IntFromAny[ref]] };
};
PopBool:
PUBLIC
PROC [frame: Frame]
RETURNS [
BOOL] ~ {
RETURN[PopInt[frame]#0];
};
PopReal:
PUBLIC
PROC [frame: Frame]
RETURNS [
REAL] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ← stack.count-1;
ref ← stack[stack.count].ref;
IF ref=
NIL
THEN {
n: NumberRep ~ stack[stack.count].num;
WITH n: n
SELECT
FROM
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
ENDCASE => RETURN[RealFromNum[n]];
}
ELSE { stack[stack.count].ref ← NIL; RETURN[RealFromAny[ref]] };
};
PopAtom:
PUBLIC
PROC [frame: Frame]
RETURNS [
ATOM] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x:
ATOM =>
RETURN[x];
ENDCASE => RETURN[AtomFromAny[x]];
};
PopRope:
PUBLIC
PROC [frame: Frame]
RETURNS [
ROPE] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x:
ROPE =>
RETURN[x];
ENDCASE => RETURN[RopeFromAny[x]];
};
PopStream:
PUBLIC
PROC [frame: Frame]
RETURNS [
STREAM] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x:
STREAM =>
RETURN[x];
ENDCASE => RETURN[StreamFromAny[x]];
};
PopCmd:
PUBLIC
PROC [frame: Frame]
RETURNS [Cmd] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Cmd =>
RETURN[x];
ENDCASE => RETURN[CmdFromAny[x]];
};
PopArray:
PUBLIC
PROC [frame: Frame]
RETURNS [Array] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Array =>
RETURN[x];
ENDCASE => RETURN[ArrayFromAny[x]];
};
PopDict:
PUBLIC
PROC [frame: Frame]
RETURNS [Dict] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Dict =>
RETURN[x];
ENDCASE => RETURN[DictFromAny[x]];
};
PopMark:
PUBLIC
PROC [frame: Frame]
RETURNS [Mark] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Mark =>
RETURN[x];
ENDCASE => RETURN[MarkFromAny[x]];
};
Copy:
PUBLIC
PROC [frame: Frame, n:
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF n<0 THEN ProduceError[invalidArgs];
IF stack.count<n THEN ProduceError[stackUnderflow];
IF (stack.size-stack.count)<n THEN ProduceError[stackOverflow];
IF n#0
THEN {
k: NAT ~ n;
b: NAT ~ stack.count-k;
FOR i:
NAT
IN[b..b+k)
DO
TRUSTED { stack[i+k] ← stack[i] }
ENDLOOP;
stack.count ← stack.count+k;
};
};
Dup:
PUBLIC
PROC [frame: Frame] ~ { Copy[frame, 1] };
Roll:
PUBLIC
PROC [frame: Frame, n, k:
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF k<0 THEN k ← n+k;
IF n<0 OR k<0 OR k>n THEN ProduceError[invalidArgs];
IF stack.count<n THEN ProduceError[stackUnderflow];
IF n=0 OR k=0 OR k=n THEN NULL
ELSE {
b: INT ~ stack.count-n;
m: INT ~ n-k;
Reverse:
PROC [bot, top:
INT] ~ {
-- reverse stack[bot..top)
FOR x:
NAT
IN[0..
NAT[top-bot]/2)
DO
i: NAT ~ bot+x; j: NAT ~ top-1-x;
temp: StackElement ~ stack[i];
TRUSTED { stack[i] ← stack[j] };
TRUSTED { stack[j] ← temp };
ENDLOOP;
};
Reverse[b, b+m]; Reverse[b+m, b+n]; Reverse[b, b+n];
}
};
Exch:
PUBLIC
PROC [frame: Frame] ~ { Roll[frame, 2, 1] };
Top:
PUBLIC
PROC [frame: Frame]
RETURNS [Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
ref ← stack[stack.count-1].ref;
IF ref=NIL THEN RETURN[NEW[NumberRep ← stack[stack.count-1].num]]
ELSE RETURN[ref];
};
TopType:
PUBLIC
PROC [frame: Frame]
RETURNS [TypeCode] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
ref ← stack[stack.count-1].ref;
IF ref=NIL THEN RETURN[number]
ELSE RETURN[Type[ref]];
};
StackIsEmpty:
PUBLIC
PROC [frame: Frame]
RETURNS [
BOOL] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
RETURN[stack.count=0];
};
CountStack:
PUBLIC
PROC [frame: Frame]
RETURNS [
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
RETURN[stack.count];
};
Index:
PUBLIC
PROC [frame: Frame, i:
INT]
RETURNS [Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
k: NAT; ref: REF;
IF i<0 THEN ProduceError[invalidArgs];
IF i>=stack.count THEN ProduceError[stackUnderflow];
k ← stack.count-1-i;
ref ← stack[k].ref;
IF ref=NIL THEN RETURN[NEW[NumberRep ← stack[k].num]]
ELSE RETURN[ref];
};
CountToMark:
PUBLIC
PROC [frame: Frame]
RETURNS [
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
FOR i:
NAT
DECREASING
IN[0..stack.count)
DO
WITH stack[i].ref
SELECT
FROM
x: Mark => RETURN[stack.count-(i+1)];
ENDCASE;
ENDLOOP;
RETURN[stack.count];
};
ClearToMark:
PUBLIC
PROC [frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
WHILE stack.count>0
DO
ref: REF ~ stack[stack.count ← stack.count-1].ref;
IF ref#NIL THEN stack[stack.count].ref ← NIL;
WITH ref SELECT FROM x: Mark => EXIT; ENDCASE;
ENDLOOP;
};
ClearStack:
PUBLIC
PROC [frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
WHILE stack.count>0
DO
ref: REF ~ stack[stack.count ← stack.count-1].ref;
IF ref#NIL THEN stack[stack.count].ref ← NIL;
ENDLOOP;
};
ApplyPop:
PUBLIC
PROC [frame: Frame] ~ {
Remove[frame];
};
ApplyCopy:
PUBLIC
PROC [frame: Frame] ~ {
n: INT ~ PopInt[frame];
Copy[frame, n];
};
ApplyDup:
PUBLIC
PROC [frame: Frame] ~ {
Copy[frame, 1];
};
ApplyRoll:
PUBLIC
PROC [frame: Frame] ~ {
k: INT ~ PopInt[frame];
n: INT ~ PopInt[frame];
Roll[frame, n, k];
};
ApplyExch:
PUBLIC
PROC [frame: Frame] ~ {
Roll[frame, 2, 1];
};
ApplyCount:
PUBLIC
PROC [frame: Frame] ~ {
n: INT ~ CountStack[frame];
PushInt[frame, n];
};
ApplyClearStack:
PUBLIC
PROC [frame: Frame] ~ {
ClearStack[frame];
};
ApplyIndex:
PUBLIC
PROC [frame: Frame] ~ {
i: INT ~ PopInt[frame];
Push[frame, Index[frame, i]];
};
defaultMark: Mark ~ NEW[MarkRep ← [0]];
ApplyMark:
PUBLIC
PROC [frame: Frame] ~ {
PushMark[frame, defaultMark];
};
ApplyCountToMark:
PUBLIC
PROC [frame: Frame] ~ {
n: INT ~ CountToMark[frame];
PushInt[frame, n];
};
ApplyClearToMark:
PUBLIC
PROC [frame: Frame] ~ {
ClearToMark[frame];
};
RegisterPrimitive[".pop", ApplyPop];
RegisterPrimitive[".exch", ApplyExch];
RegisterPrimitive[".dup", ApplyDup];
RegisterPrimitive[".clrstk", ApplyClearStack];
RegisterPrimitive[".copy", ApplyCopy];
RegisterPrimitive[".roll", ApplyRoll];
RegisterPrimitive[".cntstk", ApplyCount];
RegisterPrimitive[".cnttomrk", ApplyCountToMark];
RegisterPrimitive[".clrtomrk", ApplyClearToMark];
RegisterPrimitive[".mark", ApplyMark];
RegisterPrimitive[".index", ApplyIndex];
END.