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]]; stack.count ¬ stack.max ¬ 0; RETURN[stack]; }; Push: PUBLIC PROC [frame: Frame, val: Any] ~ { impl: FrameImpl ~ frame.impl; stack: Stack ~ impl.stack; IF NOT stack.countstack.max THEN stack.max ¬ stack.count; }; PushNum: PUBLIC PROC [frame: Frame, val: NumberRep] ~ { impl: FrameImpl ~ frame.impl; stack: Stack ~ impl.stack; IF NOT stack.countstack.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.countstack.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.countstack.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.countn THEN ProduceError[invalidArgs]; IF stack.count0 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: CommandProc ~ { Remove[frame]; }; ApplyCopy: CommandProc ~ { n: INT ~ PopInt[frame]; Copy[frame, n]; }; ApplyDup: CommandProc ~ { Copy[frame, 1]; }; ApplyRoll: CommandProc ~ { k: INT ~ PopInt[frame]; n: INT ~ PopInt[frame]; Roll[frame, n, k]; }; ApplyExch: CommandProc ~ { Roll[frame, 2, 1]; }; ApplyCount: CommandProc ~ { n: INT ~ CountStack[frame]; PushInt[frame, n]; }; ApplyClearStack: CommandProc ~ { ClearStack[frame]; }; ApplyIndex: CommandProc ~ { i: INT ~ PopInt[frame]; Push[frame, Index[frame, i]]; }; defaultMark: Mark ~ NEW[MarkRep ¬ [0]]; ApplyMark: CommandProc ~ { PushMark[frame, defaultMark]; }; ApplyCountToMark: CommandProc ~ { n: INT ~ CountToMark[frame]; PushInt[frame, n]; }; ApplyClearToMark: CommandProc ~ { 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. Κ TJaMStackImpl.mesa Copyright Σ 1985, 1986, 1987, 1991, 1992 by Xerox Corporation. All rights reserved. Michael Plass, November 19, 1987 3:58:32 pm PST Doug Wyatt, November 27, 1992 1:44 pm PST Κq–(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ ΟeœI™TK™/K™)—K˜šΟk ˜ Kšœžœ ˜Kšœ˜Kšœ ˜ —K˜KšΠbl œžœž˜Kšžœ ˜Kšžœ˜Kšœžœžœ˜K˜Kšœžœžœ˜5K˜š Οnœžœžœžœžœ ˜5Kšœžœ˜#Kšœ˜Kšžœ˜K˜K˜—K˜š œžœžœ˜.K˜Kšœ˜Kšžœžœžœo˜‘Kšžœžœžœ˜*K˜Kšœ˜Kšžœžœ˜6K˜K˜—š œžœžœ#˜7K˜Kšœ˜Kšžœžœžœo˜‘Kšžœžœžœžœ˜)Kšžœ˜&Kšœ˜Kšžœžœ˜6K˜K˜—š œžœžœžœ˜1K˜Kšœ˜K˜šžœžœžœžœ˜?Kšžœ˜&Kšœ˜Kšžœžœ˜6K˜—Kšžœ˜Kšœ˜K˜—š œžœžœžœ˜3Kšœžœžœžœ˜%Kšœ˜K˜—š œžœžœžœ˜3K˜Kšœ˜K˜šžœžœžœžœ˜?Kšžœ˜&Kšœ˜Kšžœžœ˜6K˜—Kšžœ˜Kšœ˜K˜—š œžœžœžœ˜3Kšžœžœžœ˜*Kšœ˜K˜K˜—šœ žœ˜"K˜—š œžœžœžœ˜3Kš œžœžœžœžœ žœΟc˜NKšœ˜K˜K˜—š  œžœžœžœ˜7Kšžœžœžœ˜*Kšœ˜K˜K˜—š œžœžœ˜1Kšžœžœžœ˜*Kšœ˜K˜K˜—š  œžœžœ˜5Kšžœžœžœ˜*Kšœ˜K˜K˜—š œžœžœ˜3Kšžœžœžœ˜*Kšœ˜K˜K˜—š œžœžœ˜3Kšžœžœžœ˜*Kšœ˜K˜K˜—K˜š œžœžœžœ ˜1K˜Kšœ˜Kšœžœ˜ Kšžœžœžœ˜7Kšœ˜Kšœ˜Kš žœžœžœžœžœ%˜?Kšžœžœžœ˜3K˜K˜—š œžœ˜K˜Kšœ˜Kšžœžœžœ˜7Kšœ˜Kšžœžœžœžœ˜@K˜K˜—š œžœžœžœ˜:K˜Kšœ˜Kšœžœ˜ Kšžœžœžœ˜7Kšœ˜Kšœ˜Kšžœžœžœžœ˜.Kšžœžœžœ˜CK˜K˜—š  œžœžœžœžœ˜4K˜Kšœ˜Kšœžœ˜ Kšžœžœžœ˜7Kšœ˜Kšœ˜šžœžœžœ˜Kšœ&˜&šžœžœž˜Kšœžœ˜Kšžœžœ˜!—K˜—Kšžœžœžœ˜?K˜K˜—š  œžœžœžœžœ˜6Kšžœ˜Kšœ˜K˜—š  œžœžœžœžœ˜6K˜Kšœ˜Kšœžœ˜ Kšžœžœžœ˜7Kšœ˜Kšœ˜šžœžœžœ˜Kšœ&˜&šžœžœž˜Kšœžœžœ ˜Kšœžœ ˜Kšžœžœ˜"—K˜—Kšžœžœžœ˜@K˜K˜—K˜š  œžœžœžœžœ˜6Kšœ˜š žœžœžœžœžœ˜(Kšžœžœ˜"—K˜K˜—š  œžœžœžœžœ˜6Kšœ˜š žœžœžœžœžœ˜(Kšžœžœ˜"—K˜K˜—š   œžœžœžœžœ˜:Kšœ˜š žœžœžœžœžœ˜*Kšžœžœ˜$—K˜K˜—š œžœžœžœ ˜4Kšœ˜šžœžœžœ žœ˜'Kšžœžœ˜!—K˜K˜—š œžœžœžœ ˜8Kšœ˜šžœžœžœ žœ˜)Kšžœžœ˜#—K˜K˜—š œžœžœžœ ˜6Kšœ˜šžœžœžœ žœ˜(Kšžœžœ˜"—K˜K˜—š œžœžœžœ ˜6Kšœ˜šžœžœžœ žœ˜(Kšžœžœ˜"—K˜K˜—K˜š œžœžœžœ˜,K˜Kšœ˜Kšžœžœ˜&Kšžœžœ˜3Kšžœžœo˜‘šžœžœ˜ Kšœžœ˜ Kšœžœ˜šžœžœžœ ž˜Kšžœ˜!Kšžœ˜—Kšœ˜K˜—K˜K˜—š œžœžœ%˜5K˜—š œžœžœžœ˜/K˜Kšœ˜Kšžœžœ ˜Kšžœžœžœžœ˜4Kšžœžœ˜3Kš žœžœžœžœž˜šžœ˜Kšœžœ˜Kšœžœ˜ š œžœ žœ‘˜<š žœžœžœžœ ž˜#Kšœžœ žœ ˜!Kšœ˜Kšžœ˜ Kšžœ˜Kšžœ˜—K˜—Kšœ4˜4K˜—K˜K˜—š œžœžœ(˜9K˜—K˜š œžœžœžœ ˜1K˜Kšœ˜Kšœžœ˜ Kšžœžœžœ˜7Kšœ˜Kš žœžœžœžœžœ'˜AKšžœžœ˜K˜K˜—š œžœžœžœ˜:K˜Kšœ˜Kšœžœ˜ Kšžœžœžœ˜7Kšœ˜Kšžœžœžœžœ˜Kšžœžœ ˜K˜K˜—š   œžœžœžœžœ˜;K˜Kšœ˜Kšžœ˜Kšœ˜K˜—š   œžœžœžœžœ˜8K˜Kšœ˜Kšžœ˜Kšœ˜K˜—š  œžœžœžœžœ ˜;K˜Kšœ˜Kšœžœžœ˜Kšžœžœ˜&Kšžœžœ˜4K˜Kšœ˜Kš žœžœžœžœžœ˜5Kšžœžœ˜Kšœ˜—K˜š   œžœžœžœžœ˜9K˜Kšœ˜š žœžœž œžœž˜+šžœžœž˜Kšœ žœ˜%Kšžœ˜—Kšžœ˜—Kšžœ˜K˜K˜—š  œžœžœ˜+K˜Kšœ˜šžœž˜Kšœžœ*˜2Kšžœžœžœžœ˜-Kš žœžœžœ žœžœ˜.Kšžœ˜—K˜K˜—š  œžœžœ˜*K˜Kšœ˜šžœž˜Kšœžœ*˜2Kšžœžœžœžœ˜-Kšžœ˜—K˜K˜—K˜š œœ˜Kšœ˜K˜K˜—š  œœ˜Kšœžœ˜K˜K˜K˜—š œœ˜K˜K˜K˜—š  œœ˜Kšœžœ˜Kšœžœ˜K˜K˜K˜—š  œœ˜K˜K˜K˜—š  œœ˜Kšœžœ˜K˜K˜K˜—š œœ˜ Kšœ˜K˜K˜—š  œœ˜Kšœžœ˜K˜K˜K˜—Kšœžœ˜'K˜š  œœ˜Kšœ˜K˜K˜—š œœ˜!Kšœžœ˜K˜K˜K˜—š œœ˜!Kšœ˜K˜K˜—K˜$K˜&K˜$K˜.K˜&K˜&K˜)K˜1K˜1K˜&K˜(K™Kšžœ˜—…—(Ž8Ι