DIRECTORY JaM USING [Any, Array, AtomToRope, Dict, Error, Mark, MarkRep, ROPE, STREAM, State], JaMPrimitives USING [], Real USING [Fix, RealException]; JaMStackImpl: CEDAR PROGRAM IMPORTS JaM, Real EXPORTS JaM, JaMPrimitives = BEGIN OPEN JaM; Node: TYPE = REF NodeRep; NodeRep: TYPE = RECORD[x: Any, next: Node]; Stack: TYPE = REF StackRep; StackRep: PUBLIC TYPE = RECORD[ depth: INT, -- number of items in the stack top: Node ]; max: INT = 1000; -- maximum stack depth NewStack: PUBLIC PROC RETURNS[Stack] = { RETURN[NEW[StackRep _ [depth: 0, top: NIL]]]; }; Push: PUBLIC PROC[self: State, x: Any] = { stack: Stack = self.stack; IF stack.depth0 THEN { node: Node = stack.top; [x, stack.top] _ node^; stack.depth _ stack.depth-1; } ELSE ERROR Error[StackUnderflow]; }; IntToReal: PROC[i: INT] RETURNS[REAL] = INLINE { RETURN[i] }; RealToInt: PROC[r: REAL] RETURNS[INT] = { Fix: PROC[r: REAL] RETURNS[INT] = { RETURN[Real.Fix[r]] }; i: INT = Fix[r ! Real.RealException => GOTO Fail]; IF i=r THEN RETURN[i] ELSE GOTO Fail; EXITS Fail => ERROR Error[WrongType]; }; PushBool: PUBLIC PROC[self: State, x: BOOL] = { PushInt[self, IF x THEN 1 ELSE 0] }; PushInt: PUBLIC PROC[self: State, x: INT] = { Push[self, NEW[INT _ x]]; }; PushReal: PUBLIC PROC[self: State, x: REAL] = { Push[self, NEW[REAL _ x]] }; PopBool: PUBLIC PROC[self: State] RETURNS[BOOL] = { RETURN[PopInt[self]#0]; }; PopInt: PUBLIC PROC[self: State] RETURNS[INT] = { x: Any = Pop[self]; WITH x SELECT FROM x: REF INT => RETURN[x^]; x: REF REAL => RETURN[RealToInt[x^]]; ENDCASE => ERROR Error[WrongType]; }; PopReal: PUBLIC PROC[self: State] RETURNS[REAL] = { x: Any = Pop[self]; WITH x SELECT FROM x: REF INT => RETURN[IntToReal[x^]]; x: REF REAL => RETURN[x^]; ENDCASE => ERROR Error[WrongType]; }; PopRope: PUBLIC PROC[self: State] RETURNS[ROPE] = { WITH Pop[self] SELECT FROM x: ROPE => RETURN[x]; x: ATOM => RETURN[AtomToRope[x]]; ENDCASE => ERROR Error[WrongType]; }; PopStream: PUBLIC PROC[self: State] RETURNS[STREAM] = { WITH Pop[self] SELECT FROM x: STREAM => RETURN[x]; ENDCASE => ERROR Error[WrongType]; }; PopArray: PUBLIC PROC[self: State] RETURNS[Array] = { WITH Pop[self] SELECT FROM x: Array => RETURN[x]; ENDCASE => ERROR Error[WrongType]; }; PopDict: PUBLIC PROC[self: State] RETURNS[Dict] = { WITH Pop[self] SELECT FROM x: Dict => RETURN[x]; ENDCASE => ERROR Error[WrongType]; }; Copy: PUBLIC PROC[self: State, n: INT] = { stack: Stack = self.stack; depth: INT = stack.depth; IF n<0 THEN ERROR Error[InvalidArgs] ELSE IF n>depth THEN ERROR Error[StackUnderflow] ELSE IF n>(max-depth) THEN ERROR Error[StackOverflow] ELSE { head, tail: Node _ NIL; node: Node _ stack.top; THROUGH [0..n) DO new: Node = NEW[NodeRep _ node^]; IF head=NIL THEN head _ new ELSE tail.next _ new; tail _ new; node _ node.next; ENDLOOP; IF head#NIL THEN { tail.next _ stack.top; stack.top _ head }; stack.depth _ stack.depth+n; }; }; Roll: PUBLIC PROC[self: State, n, k: INT] = { stack: Stack = self.stack; depth: INT = stack.depth; IF k<0 THEN k _ n+k; IF n<0 OR k<0 OR k>n THEN Error[InvalidArgs] ELSE IF n>depth THEN ERROR Error[StackUnderflow] ELSE IF n#0 AND k#0 AND k#n THEN { kth, nth: Node _ NIL; node: Node _ stack.top; THROUGH [0..k) DO kth _ node; node _ node.next ENDLOOP; THROUGH [k..n) DO nth _ node; node _ node.next ENDLOOP; nth.next _ stack.top; stack.top _ kth.next; kth.next _ node; }; }; Count: PUBLIC PROC[self: State] RETURNS[INT] = { stack: Stack = self.stack; RETURN[stack.depth]; }; Index: PUBLIC PROC[self: State, i: INT] RETURNS[Any] = { stack: Stack = self.stack; ERROR Error[Unimplemented]; }; PushMark: PUBLIC PROC[self: State, m: INT _ 0] = { Push[self, NEW[MarkRep _ [m]]]; }; PopMark: PUBLIC PROC[self: State, m: INT _ 0] = { WITH Pop[self] SELECT FROM x: Mark => IF x.m#m THEN ERROR Error[WrongMark]; ENDCASE => ERROR Error[WrongType]; }; CountToMark: PUBLIC PROC[self: State, m: INT _ 0] RETURNS[INT] = { stack: Stack = self.stack; depth: INT = stack.depth; node: Node _ stack.top; FOR i: INT IN[0..depth) DO WITH node.x SELECT FROM x: Mark => IF x.m=m THEN RETURN[i] ELSE ERROR Error[WrongMark]; ENDCASE; node _ node.next; ENDLOOP; RETURN[depth]; }; ApplyPop: PUBLIC PROC[self: State] = { [] _ Pop[self]; }; ApplyCopy: PUBLIC PROC[self: State] = { n: INT = PopInt[self]; Copy[self, n]; }; ApplyDup: PUBLIC PROC[self: State] = { Copy[self, 1]; }; ApplyRoll: PUBLIC PROC[self: State] = { k: INT = PopInt[self]; n: INT = PopInt[self]; Roll[self, n, k]; }; ApplyExch: PUBLIC PROC[self: State] = { Roll[self, 2, 1]; }; ApplyCount: PUBLIC PROC[self: State] = { n: INT = Count[self]; PushInt[self, n]; }; ApplyIndex: PUBLIC PROC[self: State] = { i: INT = Count[self]; Push[self, Index[self, i]]; }; ApplyMark: PUBLIC PROC[self: State] = { PushMark[self]; }; ApplyCountToMark: PUBLIC PROC[self: State] = { n: INT = CountToMark[self]; PushInt[self, n]; }; END. äJaMStackImpl.mesa Last edited by: Doug Wyatt, August 24, 1983 5:51 pm Maureen Stone February 2, 1984 5:03:06 pm PST Wrap a procedure call around Real.Fix so we can catch RealException Copy the top n entries on the stack. Ê <˜Jšœ™J™šœ™Jšœ#™#J™-—J˜šÏk ˜ Jšœœ6œœ ˜TJšœœ˜Jšœœ˜ J˜—Jšœœ˜Jšœ ˜Jšœ˜Jšœœœ˜J˜Jšœœœ ˜Jšœ œœ˜+J˜Jšœœœ ˜šœ œœœ˜JšœœÏc˜+J˜ J˜J˜—Jšœœ ž˜'J˜šÏnœœœœ ˜(Jšœœœ˜-J˜J˜—šŸœœœ˜*J˜šœœ˜Jšœ œ˜+Jšœ˜J˜Jšœ˜—Jšœœ˜ J˜J˜—šŸœœœœ ˜1J˜šœœ˜J˜J˜J˜J˜—Jšœœ˜!J˜J˜—JšŸ œœœœœœœ˜=J˜š Ÿ œœœœœ˜)š Ÿœœœœœœ˜:JšœC™C—Jšœœ!œ˜2Jš œœœœœ˜%Jšœ œ˜%J˜J˜—šŸœœœœ˜/Jšœœœœ˜!J˜J˜—šŸœœœœ˜-Jšœ œœ˜J˜J˜—šŸœœœœ˜/Jšœ œœ˜J˜J˜—š Ÿœœœœœ˜3Jšœ˜J˜J˜—š Ÿœœœœœ˜1Jšœ˜šœœ˜Jšœœœœ˜Jšœœœœ˜%Jšœœ˜"—J˜J˜—š Ÿœœœœœ˜3Jšœ˜šœœ˜Jšœœœœ˜$Jšœœœœ˜Jšœœ˜"—J˜J˜—š Ÿœœœœœ˜3šœ œ˜Jšœœœ˜Jšœœœ˜!Jšœœ˜"—J˜J˜—š Ÿ œœœœœ˜7š œ œœœœ˜2Jšœœ˜"—J˜J˜—šŸœœœœ ˜5šœ œœ œ˜1Jšœœ˜"—J˜J˜—šŸœœœœ ˜3šœ œœ œ˜0Jšœœ˜"—J˜J˜—šŸœœœœ˜*Jšœ$™$J˜Jšœœ˜Jšœœœ˜$Jšœœ œœ˜0Jšœœœœ˜5šœ˜Jšœœ˜J˜šœ˜Jšœ œ˜!Jšœœœ œ˜1J˜Jšœ˜—Jšœœœ-˜=J˜J˜—J˜—J˜šŸœœœœ˜-J˜Jšœœ˜Jšœœ ˜Jšœœœœ˜,Jšœœ œœ˜0š œœœœœ˜"Jšœœ˜J˜Jšœœœ˜7Jšœœœ˜7J˜J˜J˜J˜—J˜—J˜š Ÿœœœœœ˜0J˜Jšœ˜Jšœ˜—J˜š Ÿœœœœœ ˜8J˜Jšœ˜Jšœ˜—J˜šŸœœœœ ˜2Jšœ œ˜J˜J˜—šŸœœœœ ˜1šœ œ˜Jšœ œœœ˜0Jšœœ˜"—J˜J˜—š Ÿ œœœœœœ˜BJ˜Jšœœ˜J˜šœœœ ˜šœœ˜Jš œ œœœœœ˜?Jšœ˜—J˜Jšœ˜—Jšœ˜J˜J˜—šŸœœœ˜&J˜J˜J˜—šŸ œœœ˜'Jšœœ˜J˜J˜J˜—šŸœœœ˜&J˜J˜J˜—šŸ œœœ˜'Jšœœ˜Jšœœ˜J˜J˜J˜—šŸ œœœ˜'J˜J˜J˜—šŸ œœœ˜(Jšœœ˜J˜J˜J˜—šŸ œœœ˜(Jšœœ˜J˜J˜J˜—šŸ œœœ˜'J˜J˜J˜—šŸœœœ˜.Jšœœ˜J˜J˜J˜—Jšœ˜—…—ü