DIRECTORY JaM, JaMPrimitives, Real; JaMStackImpl: CEDAR PROGRAM IMPORTS JaM, Real EXPORTS JaM, JaMPrimitives ~ BEGIN OPEN JaM; NumberRep: TYPE ~ RECORD[ SELECT tag: * FROM int => [int: INT], real => [real: REAL], ENDCASE ]; AnyFromNum: PROC[n: NumberRep] RETURNS[Any] ~ { WITH n: n SELECT FROM int => RETURN[NEW[INT ¬ n.int]]; real => RETURN[NEW[REAL ¬ n.real]]; ENDCASE => ERROR; }; NumFromAny: PROC[x: Any] RETURNS[NumberRep] ~ { WITH x SELECT FROM x: REF INT => RETURN[[int[x­]]]; x: REF REAL => RETURN[[real[x­]]]; ENDCASE => ERROR Error[WrongType]; }; firstInt: REAL ¬ INT.FIRST; lastInt: REAL ¬ INT.LAST; IntFromReal: PROC[r: REAL] RETURNS[INT] ~ { i: INT ¬ 0; IF r IN[firstInt..lastInt] THEN i ¬ Real.Fix[r]; IF i=r THEN RETURN[i]; ERROR Error[WrongType]; }; IntFromNum: PROC[n: NumberRep] RETURNS[INT] ~ { WITH n: n SELECT FROM int => RETURN[n.int]; real => RETURN[IntFromReal[n.real]]; ENDCASE => ERROR; }; IntFromAny: PROC[x: Any] RETURNS[INT] ~ { WITH x SELECT FROM x: REF INT => RETURN[x­]; x: REF REAL => RETURN[IntFromReal[x­]]; ENDCASE => ERROR Error[WrongType]; }; RealFromNum: PROC[n: NumberRep] RETURNS[REAL] ~ { WITH n: n SELECT FROM int => RETURN[REAL[n.int]]; real => RETURN[n.real]; ENDCASE => ERROR; }; RealFromAny: PROC[x: Any] RETURNS[REAL] ~ { WITH x SELECT FROM x: REF INT => RETURN[REAL[x­]]; x: REF REAL => RETURN[x­]; ENDCASE => ERROR Error[WrongType]; }; arraySize: NAT ~ 8; StackArray: TYPE ~ REF StackArrayRep; StackArrayRep: TYPE ~ ARRAY[0..arraySize) OF NumberRep; StackList: TYPE ~ LIST OF Any; Stack: TYPE ~ REF StackRep; StackRep: PUBLIC TYPE ~ RECORD[ array: StackArray ¬ NIL, -- a few numbers on top of the stack arrayCount: [0..arraySize] ¬ 0, -- number of elements in array list: StackList ¬ NIL, -- the rest of the stack count: INT ¬ 0, -- number of stack elements above the top mark countMax: INT ¬ 0 -- maximum count permitted above the top mark ]; NewStack: PUBLIC PROC RETURNS[Stack] ~ { stack: Stack ~ NEW[StackRep ¬ []]; stack.array ¬ NEW[StackArrayRep]; stack.countMax ¬ LAST[INTEGER]; RETURN[stack]; }; FlushStackArray: PROC[stack: Stack] ~ { FOR i: NAT IN[0..stack.arrayCount) DO n: NumberRep ~ stack.array[i]; stack.list ¬ CONS[AnyFromNum[n], stack.list]; ENDLOOP; stack.arrayCount ¬ 0; }; Push: PUBLIC PROC[self: State, x: Any] ~ { stack: Stack ~ self.stack; IF NOT stack.count0 THEN ERROR Error[StackUnderflow]; stack.count ¬ stack.count-1; IF stack.arrayCount>0 THEN { n: NumberRep ~ stack.array[stack.arrayCount ¬ stack.arrayCount-1]; RETURN[AnyFromNum[n]]; } ELSE { top: StackList ~ stack.list; stack.list ¬ top.rest; RETURN[top.first] }; }; PopNum: PROC[self: State] RETURNS[NumberRep] ~ { stack: Stack ~ self.stack; IF stack.count>0 AND stack.arrayCount>0 THEN { n: NumberRep ~ stack.array[stack.arrayCount ¬ stack.arrayCount-1]; stack.count ¬ stack.count-1; RETURN[n]; } ELSE RETURN[NumFromAny[Pop[self]]]; }; PopBool: PUBLIC PROC[self: State] RETURNS[BOOL] ~ { RETURN[PopInt[self]#0]; }; PopInt: PUBLIC PROC[self: State] RETURNS[INT] ~ { stack: Stack ~ self.stack; IF stack.count>0 AND stack.arrayCount>0 THEN { n: NumberRep ~ stack.array[stack.arrayCount ¬ stack.arrayCount-1]; stack.count ¬ stack.count-1; WITH n: n SELECT FROM int => RETURN[n.int]; ENDCASE; RETURN[IntFromNum[n]]; } ELSE RETURN[IntFromAny[Pop[self]]]; }; PopReal: PUBLIC PROC[self: State] RETURNS[REAL] ~ { stack: Stack ~ self.stack; IF stack.count>0 AND stack.arrayCount>0 THEN { n: NumberRep ~ stack.array[stack.arrayCount ¬ stack.arrayCount-1]; stack.count ¬ stack.count-1; WITH n: n SELECT FROM int => RETURN[REAL[n.int]]; real => RETURN[n.real]; ENDCASE; RETURN[RealFromNum[n]]; } ELSE RETURN[RealFromAny[Pop[self]]]; }; PopRope: PUBLIC PROC[self: State] RETURNS[ROPE] ~ { x: Any ~ Pop[self]; WITH x SELECT FROM x: ROPE => RETURN[x]; x: ATOM => RETURN[AtomToRope[x]]; ENDCASE => ERROR Error[WrongType]; }; PopStream: PUBLIC PROC[self: State] RETURNS[STREAM] ~ { x: Any ~ Pop[self]; WITH x SELECT FROM x: STREAM => RETURN[x]; ENDCASE => ERROR Error[WrongType]; }; PopArray: PUBLIC PROC[self: State] RETURNS[Array] ~ { x: Any ~ Pop[self]; WITH x SELECT FROM x: Array => RETURN[x]; ENDCASE => ERROR Error[WrongType]; }; PopDict: PUBLIC PROC[self: State] RETURNS[Dict] ~ { x: Any ~ Pop[self]; WITH x SELECT FROM x: Dict => RETURN[x]; ENDCASE => ERROR Error[WrongType]; }; Copy: PUBLIC PROC[self: State, n: INT] ~ { stack: Stack ~ self.stack; IF n<0 THEN ERROR Error[InvalidArgs]; IF NOT stack.count>=n THEN ERROR Error[StackUnderflow]; IF NOT (stack.countMax-stack.count)>=n THEN ERROR Error[StackOverflow]; IF n=0 THEN RETURN; IF stack.arrayCount>=n AND (arraySize-stack.arrayCount)>=n THEN { k: NAT ~ n; b: NAT ~ stack.arrayCount-k; array: StackArray ~ stack.array; FOR i: NAT IN[b..b+k) DO TRUSTED{ array[i+k] ¬ array[i] } ENDLOOP; stack.arrayCount ¬ stack.arrayCount+k; } ELSE { head, tail, each: StackList ¬ NIL; IF NOT stack.arrayCount=0 THEN FlushStackArray[stack]; each ¬ stack.list; THROUGH [0..n) DO copy: StackList ~ CONS[each.first, NIL]; IF tail=NIL THEN head ¬ copy ELSE tail.rest ¬ copy; tail ¬ copy; each ¬ each.rest; ENDLOOP; tail.rest ¬ stack.list; stack.list ¬ head; }; stack.count ¬ stack.count+n; }; Roll: PUBLIC PROC[self: State, n, k: INT] ~ { stack: Stack ~ self.stack; IF k<0 THEN k ¬ n+k; IF n<0 OR k<0 OR k>n THEN ERROR Error[InvalidArgs]; IF n>stack.count THEN ERROR Error[StackUnderflow]; IF n=0 OR k=0 OR k=n THEN RETURN; IF stack.arrayCount>=n THEN { m: INT ~ n-k; b: INT ~ stack.arrayCount-n; a: StackArray ~ stack.array; Reverse: PROC[bot, top: INT] ~ { -- reverse a[bot..top) FOR x: NAT IN[0..NAT[top-bot]/2) DO i: NAT ~ bot+x; j: NAT ~ top-1-x; temp: NumberRep ~ a[i]; TRUSTED{ a[i] ¬ a[j] }; TRUSTED{ a[j] ¬ temp }; ENDLOOP; }; Reverse[b, b+m]; Reverse[b+m, b+n]; Reverse[b, b+n]; } ELSE { top, kth, nth, each: StackList ¬ NIL; IF NOT stack.arrayCount=0 THEN FlushStackArray[stack]; each ¬ top ¬ stack.list; THROUGH [0..k) DO kth ¬ each; each ¬ each.rest ENDLOOP; stack.list ¬ each; -- new top of stack THROUGH [k..n) DO nth ¬ each; each ¬ each.rest ENDLOOP; kth.rest ¬ each; nth.rest ¬ top; }; }; Count: PUBLIC PROC[self: State] RETURNS[INT] ~ { stack: Stack ~ self.stack; RETURN[stack.count]; }; 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; list: StackList ¬ stack.list; FOR i: INT IN[stack.arrayCount..stack.count) DO WITH list.first SELECT FROM x: Mark => IF x.m=m THEN RETURN[i] ELSE ERROR Error[WrongMark]; ENDCASE; list ¬ list.rest; ENDLOOP; RETURN[stack.count]; }; ApplyPop: PUBLIC PROC[self: State] ~ { stack: Stack ~ self.stack; IF stack.count>0 AND stack.arrayCount>0 THEN { -- Avoid useless NEW stack.count ¬ stack.count-1; stack.arrayCount ¬ stack.arrayCount-1; } ELSE [] ¬ 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 Copyright Σ 1985, 1992 by Xerox Corporation. All rights reserved. Doug Wyatt, March 18, 1985 3:31:31 pm PST Stone, December 4, 1985 10:23:44 am PST ΚΪ•NewlineDelimiter –"cedarcode" style™codešœ™Kšœ Οeœ6™BKšœ)™)K™'—K˜šΟk ˜ Kšœ˜Kšœ˜Kšœ˜—K˜KšΠbl œžœž˜Kšžœ ˜Kšžœ˜Kšœžœžœ˜K˜šœ žœžœ˜šžœž˜Kšœ žœ˜Kšœžœ˜Kšž˜—K˜—K˜šΟn œžœžœ ˜/šžœžœž˜Kšœžœžœžœ ˜ Kšœžœžœžœ ˜#Kšžœžœ˜—K˜K˜—š  œžœ žœ˜/šžœžœž˜Kšœžœžœžœ ˜ Kšœžœžœžœ ˜"Kšžœžœ˜"—K˜K˜—Kšœ žœžœžœ˜Kšœ žœžœžœ˜K˜š   œžœžœžœžœ˜+Kšœžœ˜ Kšžœžœžœ˜0Kšžœžœžœ˜Kšžœ˜K˜K˜—š  œžœžœžœ˜/šžœžœž˜Kšœžœ˜Kšœžœ˜$Kšžœžœ˜—K˜K˜—š  œžœ žœžœ˜)šžœžœž˜Kšœžœžœžœ˜Kšœžœžœžœ˜'Kšžœžœ˜"—K˜K˜—š  œžœžœžœ˜1šžœžœž˜Kšœžœžœ ˜Kšœžœ ˜Kšžœžœ˜—K˜K˜—š  œžœ žœžœ˜+šžœžœž˜Kš œžœžœžœžœ˜Kšœžœžœžœ˜Kšžœžœ˜"—K˜K˜—K˜Kšœ žœ˜Kšœ žœžœ˜%Kšœžœžœžœ ˜7Kšœ žœžœžœ˜K˜Kšœžœžœ ˜šœ žœžœžœ˜KšœžœΟc$˜=Kšœ ‘˜>Kšœžœ‘˜/Kšœžœ‘.˜>Kšœ žœ‘-˜?K˜K˜—K˜š œžœžœžœ ˜(Kšœžœ˜"Kšœžœ˜!Kšœžœžœ˜Kšžœ˜K˜K˜—š œžœ˜'šžœžœžœž˜%Kšœ˜Kšœ žœ˜-Kšžœ˜—K˜K˜K˜—K˜š œžœžœ˜*Kšœ˜Kšžœžœžœžœ˜BKšžœžœžœ˜6Kšœ žœ˜!K˜K˜K˜—š œžœ˜,Kšœ˜Kšžœžœžœžœ˜BKšžœžœžœ˜>Kšžœ&˜-K˜&K˜K˜K˜—š œžœžœžœ˜/Kšœžœžœžœ˜"Kšœ˜K˜—š œžœžœžœ˜-Kšœ˜K˜šžœžœžœ˜CKšžœ&˜-K˜&K˜K˜—Kšžœ˜Kšœ˜K˜—š œžœžœžœ˜/Kšœ˜K˜šžœžœžœ˜CKšžœ&˜-K˜&K˜K˜—Kšžœ˜Kšœ˜K˜—K˜š œžœžœžœ ˜.Kšœ˜Kšžœžœžœžœ˜6K˜šžœžœ˜K˜BKšžœ˜K˜—Kšžœ7žœ˜OK˜K˜—š œžœžœ˜0Kšœ˜šžœžœžœ˜.K˜BK˜Kšžœ˜ K˜—Kšžœžœ˜#K˜K˜—š  œžœžœžœžœ˜3Kšžœ˜Kšœ˜K˜—š  œžœžœžœžœ˜1Kšœ˜šžœžœžœ˜.K˜BK˜šžœžœž˜Kšœžœ˜Kšžœ˜—Kšžœ˜K˜—Kšžœžœ˜#K˜K˜—š  œžœžœžœžœ˜3Kšœ˜šžœžœžœ˜.K˜BK˜šžœžœž˜Kšœžœžœ ˜Kšœžœ ˜Kšžœ˜—Kšžœ˜K˜—Kšžœžœ˜$K˜K˜—K˜š  œžœžœžœžœ˜3K˜šžœžœž˜Kšœžœžœ˜Kšœžœžœ˜!Kšžœžœ˜"—K˜K˜—š   œžœžœžœžœ˜7K˜šžœžœž˜Kšœžœžœ˜Kšžœžœ˜"—K˜K˜—š œžœžœžœ ˜5K˜šžœžœž˜Kšœ žœ˜Kšžœžœ˜"—K˜K˜—š œžœžœžœ ˜3K˜šžœžœž˜Kšœ žœ˜Kšžœžœ˜"—K˜K˜—K˜š œžœžœžœ˜*K˜Kšžœžœžœ˜%Kšžœžœžœžœ˜7Kšžœžœ!žœžœ˜GKšžœžœžœ˜šžœžœ!žœ˜AKšœžœ˜ Kšœžœ˜Kšœ ˜ Kš žœžœžœ žœžœžœ˜BK˜&K˜—šžœ˜Kšœžœ˜"Kšžœžœžœ˜6K˜šžœž˜Kšœžœ žœ˜(Kšžœžœžœ žœ˜3K˜Kšžœ˜—K˜*K˜—K˜K˜K˜—š œžœžœžœ˜-K˜Kšžœžœ ˜Kš žœžœžœžœžœ˜3Kšžœžœžœ˜2Kš žœžœžœžœžœ˜!šžœžœ˜Kšœžœ˜ Kšœžœ˜Kšœ˜š œžœ žœ‘˜7š žœžœžœžœ ž˜#Kšœžœ žœ ˜!Kšœ˜Kšžœ˜Kšžœ˜Kšžœ˜—K˜—Kšœ4˜4K˜—šžœ˜Kšœ!žœ˜%Kšžœžœžœ˜6K˜Kšžœžœžœ˜7Kšœ‘˜&Kšžœžœžœ˜7K˜ K˜—K˜K˜—K˜š  œžœžœžœžœ˜0K˜Kšžœ˜Kšœ˜K˜—š  œžœžœžœžœ ˜8K˜Kšžœ˜Kšœ˜—K˜š œžœžœžœ ˜2Kšœ žœ˜K˜K˜—š œžœžœžœ ˜1šžœ žœž˜Kšœ žœžœžœ˜0Kšžœžœ˜"—K˜K˜—š   œžœžœžœžœžœ˜BK˜K˜šžœžœžœ ž˜/šžœ žœž˜Kš œ žœžœžœžœžœ˜?Kšžœ˜—K˜Kšžœ˜—Kšžœ˜K˜K˜—K˜š œžœžœ˜&K˜šžœžœžœ‘˜CK˜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šžœ˜—…—#n2ψ