DIRECTORY Convert USING [IntFromRope, RealFromRope], TJaM, Real USING [Round], Rope USING [Equal, Length]; TJaMTypeImpl: CEDAR PROGRAM IMPORTS Convert, TJaM, Rope, Real EXPORTS TJaM ~ BEGIN OPEN TJaM; firstInt: REAL ¬ INT.FIRST; lastInt: REAL ¬ INT.LAST; IntFromReal: PUBLIC PROC [real: REAL] RETURNS [INT] ~ { int: INT ¬ 0; IF real IN[firstInt..lastInt] THEN int ¬ Real.Round[real]; IF int#real THEN ProduceError[wrongType]; RETURN[int]; }; IntFromNum: PUBLIC PROC [n: NumberRep] RETURNS [INT] ~ { WITH n: n SELECT FROM int => RETURN[n.int]; real => RETURN[IntFromReal[n.real]]; ENDCASE => ERROR; }; RealFromNum: PUBLIC PROC [n: NumberRep] RETURNS [REAL] ~ { WITH n: n SELECT FROM int => RETURN[REAL[n.int]]; real => RETURN[n.real]; ENDCASE => ERROR; }; IntFromAny: PUBLIC PROC [x: REF] RETURNS [INT] ~ { WITH x SELECT FROM x: Number => { n: NumberRep ~ x­; WITH n: n SELECT FROM int => RETURN[n.int]; ENDCASE; RETURN[IntFromNum[n]]; }; ENDCASE; ProduceError[wrongType]; RETURN[0]; }; RealFromAny: PUBLIC PROC [x: Any] RETURNS [REAL] ~ { WITH x SELECT FROM x: Number => { n: NumberRep ~ x­; WITH n: n SELECT FROM int => RETURN[REAL[n.int]]; real => RETURN[n.real]; ENDCASE; RETURN[RealFromNum[n]]; }; ENDCASE; ProduceError[wrongType]; RETURN[0]; }; NumberFromAny: PUBLIC PROC [x: Any] RETURNS [Number] ~ { WITH x SELECT FROM x: Number => RETURN[x]; x: Ob => RETURN[NumberFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; AtomFromAny: PUBLIC PROC [x: Any] RETURNS [ATOM] ~ { WITH x SELECT FROM x: ATOM => RETURN[x]; x: Ob => RETURN[AtomFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; RopeFromAny: PUBLIC PROC [x: Any] RETURNS [ROPE] ~ { WITH x SELECT FROM x: ROPE => RETURN[x]; x: Ob => RETURN[RopeFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; StreamFromAny: PUBLIC PROC [x: Any] RETURNS [STREAM] ~ { WITH x SELECT FROM x: STREAM => RETURN[x]; x: Ob => RETURN[StreamFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; CmdFromAny: PUBLIC PROC [x: Any] RETURNS [Cmd] ~ { WITH x SELECT FROM x: Cmd => RETURN[x]; x: Ob => RETURN[CmdFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; ArrayFromAny: PUBLIC PROC [x: Any] RETURNS [Array] ~ { WITH x SELECT FROM x: Array => RETURN[x]; x: Ob => RETURN[ArrayFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; DictFromAny: PUBLIC PROC [x: Any] RETURNS [Dict] ~ { WITH x SELECT FROM x: Dict => RETURN[x]; x: Ob => RETURN[DictFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; MarkFromAny: PUBLIC PROC [x: Any] RETURNS [Mark] ~ { WITH x SELECT FROM x: Mark => RETURN[x]; x: Ob => RETURN[MarkFromAny[x.body]]; ENDCASE; ProduceError[wrongType]; RETURN[NIL]; }; Type: PUBLIC PROC [x: Any] RETURNS [TypeCode] ~ { IF x=NIL THEN RETURN[nil]; RETURN[WITH x SELECT FROM x: Number => number, x: ATOM => atom, x: ROPE => rope, x: STREAM => stream, x: Cmd => cmd, x: Dict => dict, x: Array => array, x: Mark => mark, x: Ob => Type[x.body], ENDCASE => other]; }; TypeAtomArray: TYPE ~ REF TypeAtomArrayRep; TypeAtomArrayRep: TYPE ~ ARRAY TypeCode OF ATOM; typeAtom: TypeAtomArray ~ NEW[TypeAtomArrayRep ¬ [ nil: AtomFromRope[".nil"], number: AtomFromRope[".number"], atom: AtomFromRope[".atom"], rope: AtomFromRope[".rope"], stream: AtomFromRope[".stream"], cmd: AtomFromRope[".cmd"], dict: AtomFromRope[".dict"], array: AtomFromRope[".array"], mark: AtomFromRope[".mark"], other: AtomFromRope[".other"] ]]; Length: PUBLIC PROC [x: Any] RETURNS [INT] ~ { WITH x SELECT FROM x: Array => RETURN[x.len]; x: Dict => RETURN[DictLength[x]]; x: ROPE => RETURN[Rope.Length[x]]; x: Ob => RETURN[Length[x.body]]; ENDCASE; RETURN[1]; }; Equal: PUBLIC PROC [a, b: Any] RETURNS [BOOL] ~ { IF a=b THEN RETURN[TRUE]; WITH a SELECT FROM a: Number => WITH b SELECT FROM b: Number => WITH a: a SELECT FROM int => WITH b: b SELECT FROM int => RETURN[a.int=b.int]; real => RETURN[a.int=b.real]; ENDCASE => ERROR; real => WITH b: b SELECT FROM int => RETURN[a.real=b.int]; real => RETURN[a.real=b.real]; ENDCASE => ERROR; ENDCASE => ERROR; ENDCASE; a: ATOM => WITH b SELECT FROM b: ATOM => RETURN[a=b]; b: ROPE => RETURN[a=AtomFromRope[b]]; ENDCASE; a: ROPE => WITH b SELECT FROM b: ATOM => RETURN[AtomFromRope[a]=b]; b: ROPE => RETURN[Rope.Equal[a, b]]; ENDCASE; ENDCASE; WITH a SELECT FROM a: Ob => RETURN[Equal[a.body, b]]; ENDCASE; WITH b SELECT FROM b: Ob => RETURN[Equal[a, b.body]]; ENDCASE; RETURN[FALSE]; }; CvX: PUBLIC PROC [x: Any] RETURNS [Any] ~ { WITH x SELECT FROM x: Ob => RETURN[IF x.tag=executable THEN x ELSE CvX[x.body]]; ENDCASE => RETURN[NEW[ObRep ¬ [tag: executable, body: x]]]; }; CvLit: PUBLIC PROC [x: Any] RETURNS [Any] ~ { WITH x SELECT FROM x: Ob => RETURN[IF x.tag=literal THEN x ELSE CvLit[x.body]]; ENDCASE => RETURN[NEW[ObRep ¬ [tag: literal, body: x]]]; }; CvI: PUBLIC PROC [x: Any] RETURNS [INT] ~ { WITH x SELECT FROM x: Number => WITH x: x SELECT FROM int => RETURN[x.int]; real => RETURN[Real.Round[x.real]]; ENDCASE => ProduceError[bug]; x: ROPE => RETURN[Convert.IntFromRope[x]]; x: Ob => RETURN[CvI[x.body]]; ENDCASE => ProduceError[wrongType]; RETURN[0]; }; CvR: PUBLIC PROC [x: Any] RETURNS [REAL] ~ { WITH x SELECT FROM x: Number => WITH x: x SELECT FROM int => RETURN[REAL[x.int]]; real => RETURN[x.real]; ENDCASE => ProduceError[bug]; x: ROPE => RETURN[Convert.RealFromRope[x]]; x: Ob => RETURN[CvR[x.body]]; ENDCASE => ProduceError[wrongType]; RETURN[0]; }; ApplyType: CommandProc ~ { x: Any ~ Pop[frame]; type: TypeCode ~ Type[x]; PushAtom[frame, typeAtom[type]]; }; ApplyLength: CommandProc ~ { x: Any ~ Pop[frame]; PushInt[frame, Length[x]]; }; ApplyCvLit: CommandProc ~ { x: Any ~ Pop[frame]; Push[frame, CvLit[x]]; }; ApplyCvX: CommandProc ~ { x: Any ~ Pop[frame]; Push[frame, CvX[x]]; }; ApplyCvI: CommandProc ~ { x: Any ~ Pop[frame]; PushInt[frame, CvI[x]]; }; ApplyCvR: CommandProc ~ { x: Any ~ Pop[frame]; PushReal[frame, CvR[x]]; }; ApplyCommandName: CommandProc ~ { x: Cmd ~ PopCmd[frame]; PushAtom[frame, x.name]; }; RegisterPrimitive[".type", ApplyType]; RegisterPrimitive[".length", ApplyLength]; RegisterPrimitive[".cvlit", ApplyCvLit]; RegisterPrimitive[".cvx", ApplyCvX]; RegisterPrimitive[".cvi", ApplyCvI]; RegisterPrimitive[".cvr", ApplyCvR]; RegisterPrimitive[".commandname", ApplyCommandName]; END. Β TJaMTypeImpl.mesa Copyright Σ 1985, 1986, 1991, 1993 by Xerox Corporation. All rights reserved. Maureen Stone February 6, 1984 5:07:45 pm PST Doug Wyatt, October 19, 1993 12:56 pm PDT Κ –(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ ΟeœC™NK™-K™)K™—šΟk ˜ Kšœžœ˜*Kšœ˜Kšœžœ ˜Kšœžœ˜—K˜KšΠbl œžœž˜Kšžœ˜!Kšžœ˜ Kšœžœžœ˜K˜Kšœ žœžœžœ˜Kšœ žœžœžœ˜K˜š Οn œžœžœžœžœžœ˜7Kšœžœ˜ Kšžœžœžœ˜:Kšžœ žœ˜)Kšžœ˜ K˜K˜—š   œžœžœžœžœ˜8šžœžœž˜Kšœžœ˜Kšœžœ˜$Kšžœžœ˜—K˜K˜—š   œžœžœžœžœ˜:šžœžœž˜Kšœžœžœ ˜Kšœžœ ˜Kšžœžœ˜—K˜K˜—š   œžœžœžœžœžœ˜2šžœžœž˜šœ˜Kšœ˜šžœžœž˜Kšœžœ˜Kšžœ˜—Kšžœ˜K˜—Kšžœ˜—Kšœžœ˜#K˜K˜—š   œžœžœ žœžœ˜4šžœžœž˜šœ˜Kšœ˜šžœžœž˜Kšœžœžœ ˜Kšœžœ ˜Kšžœ˜—Kšžœ˜K˜—Kšžœ˜—Kšœžœ˜#K˜K˜—K˜š  œžœžœ žœ ˜8šžœžœž˜Kšœ žœ˜Kšœ žœ˜'Kšžœ˜—Kšœžœžœ˜%K˜K˜—š   œžœžœ žœžœ˜4šžœžœž˜Kšœžœžœ˜Kšœ žœ˜%Kšžœ˜—Kšœžœžœ˜%K˜K˜—š   œžœžœ žœžœ˜4šžœžœž˜Kšœžœžœ˜Kšœ žœ˜%Kšžœ˜—Kšœžœžœ˜%K˜K˜—š   œžœžœ žœžœ˜8šžœžœž˜Kšœžœžœ˜Kšœ žœ˜'Kšžœ˜—Kšœžœžœ˜%K˜K˜—š  œžœžœ žœ ˜2šžœžœž˜Kšœ žœ˜Kšœ žœ˜$Kšžœ˜—Kšœžœžœ˜%K˜K˜—š  œžœžœ žœ ˜6šžœžœž˜Kšœ žœ˜Kšœ žœ˜&Kšžœ˜—Kšœžœžœ˜%K˜K˜—š  œžœžœ žœ ˜4šžœžœž˜Kšœ žœ˜Kšœ žœ˜%Kšžœ˜—Kšœžœžœ˜%K˜K˜—š  œžœžœ žœ ˜4šžœžœž˜Kšœ žœ˜Kšœ žœ˜%Kšžœ˜—Kšœžœžœ˜%K˜K˜—š œžœžœ žœ˜1Kšžœžœžœžœ˜šžœžœžœž˜Kšœ˜Kšœžœ ˜Kšœžœ ˜Kšœžœ ˜Kšœ˜K˜K˜K˜K˜Kšžœ ˜—K˜K˜—K˜Kšœžœžœ˜+Kš œžœžœ žœžœ˜0šœžœ˜2K˜Kšœ ˜ Kšœ˜Kšœ˜Kšœ ˜ Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜Kšœ˜—K˜š  œžœžœ žœžœ˜.šžœžœž˜Kšœ žœ˜Kšœ žœ˜!Kšœžœžœ˜"Kšœ žœ˜ Kšžœ˜—Kšžœ˜ Kšœ˜K˜—š  œžœžœ žœžœ˜1Kšžœžœžœžœ˜šžœžœž˜šœ žœžœž˜šœ žœžœž˜"šœžœžœž˜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š œ žœžœžœžœ˜