DIRECTORY PS, Real; PSTypeImpl: CEDAR PROGRAM IMPORTS PS, Real EXPORTS PS ~ BEGIN OPEN PS; NameFromTypeArray: TYPE ~ ARRAY TypeCode OF Name; nameFromType: REF NameFromTypeArray ~ NEW [NameFromTypeArray _ [ null: NameFromRope["nulltype"], integer: NameFromRope["integertype"], real: NameFromRope["realtype"], boolean: NameFromRope["booleantype"], array: NameFromRope["arraytype"], string: NameFromRope["stringtype"], name: NameFromRope["nametype"], dict: NameFromRope["dicttype"], operator: NameFromRope["operatortype"], file: NameFromRope["filetype"], mark: NameFromRope["marktype"], save: NameFromRope["savetype"], font: NameFromRope["fonttype"] ]]; NameFromType: PUBLIC PROC [type: TypeCode] RETURNS [Name] ~ { RETURN [nameFromType[type]]; }; CvLit: PUBLIC PROC [x: Any] RETURNS [Any] ~ { x.val.executable _ FALSE; RETURN [x]; }; CvX: PUBLIC PROC [x: Any] RETURNS [Any] ~ { x.val.executable _ TRUE; RETURN [x]; }; ArraySetAccess: PROC [array: Array, access: Access] RETURNS [Array] ~ { IF array.val.access RETURN [ArrayAccess[ArrayFromAny[x]]]; dict => RETURN [DictAccess[DictFromAny[x]]]; file => RETURN [FileAccess[FileFromAny[x]]]; string => RETURN [StringAccess[StringFromAny[x]]]; ENDCASE => ERROR Error[typecheck]; }; SetAccess: PUBLIC PROC [x: Any, access: Access] RETURNS [Any] ~ { SELECT Type[x] FROM array => RETURN [AnyFromArray[ArraySetAccess[ArrayFromAny[x], access]]]; dict => RETURN [AnyFromDict[DictSetAccess[DictFromAny[x], access]]]; file => RETURN [AnyFromFile[FileSetAccess[FileFromAny[x], access]]]; string => RETURN [AnyFromString[StringSetAccess[StringFromAny[x], access]]]; ENDCASE => ERROR Error[typecheck]; }; IntFromAny: PUBLIC PROC [x: Any] RETURNS [INT] ~ { WITH val: x.val SELECT FROM integer => RETURN [val.int]; ENDCASE => ERROR Error[typecheck]; }; RealFromAny: PUBLIC PROC [x: Any] RETURNS [REAL] ~ { WITH val: x.val SELECT FROM integer => RETURN [REAL[val.int]]; real => RETURN [val.real]; ENDCASE => ERROR Error[typecheck]; }; NumFromAny: PUBLIC PROC [x: Any] RETURNS [Num] ~ { WITH val: x.val SELECT FROM integer => RETURN [[int[val.int]]]; real => RETURN [[real[val.real]]]; ENDCASE => ERROR Error[typecheck]; }; BoolFromAny: PUBLIC PROC [x: Any] RETURNS [BOOL] ~ { WITH val: x.val SELECT FROM boolean => RETURN [val.bool]; ENDCASE => ERROR Error[typecheck]; }; ArrayFromAny: PUBLIC PROC [x: Any] RETURNS [Array] ~ { WITH val: x.val SELECT FROM array => WITH x.ref SELECT FROM ref: ArrayRef => RETURN [[val: val, ref: ref]]; ENDCASE => ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; StringFromAny: PUBLIC PROC [x: Any] RETURNS [String] ~ { WITH val: x.val SELECT FROM string => WITH x.ref SELECT FROM ref: StringRef => RETURN [[val: val, ref: ref]]; ENDCASE => ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; FileFromAny: PUBLIC PROC [x: Any] RETURNS [File] ~ { WITH val: x.val SELECT FROM file => WITH x.ref SELECT FROM ref: FileRef => RETURN [[val: val, ref: ref]]; ENDCASE => ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; NameFromAny: PUBLIC PROC [x: Any] RETURNS [Name] ~ { WITH val: x.val SELECT FROM name => WITH x.ref SELECT FROM ref: NameRef => RETURN [[val: val, ref: ref]]; ENDCASE => ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; DictFromAny: PUBLIC PROC [x: Any] RETURNS [Dict] ~ { WITH val: x.val SELECT FROM dict => WITH x.ref SELECT FROM ref: DictRef => RETURN [[val: val, ref: ref]]; ENDCASE => ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; OperatorFromAny: PUBLIC PROC [x: Any] RETURNS [Operator] ~ { WITH val: x.val SELECT FROM operator => WITH x.ref SELECT FROM ref: OperatorRef => RETURN [[val: val, ref: ref]]; ENDCASE => ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; AnyFromInt: PUBLIC PROC [int: INT] RETURNS [Any] ~ { RETURN [[ val: [executable: FALSE, variant: integer[int: int]], ref: NIL ]]; }; AnyFromReal: PUBLIC PROC [real: REAL] RETURNS [Any] ~ { RETURN [[ val: [executable: FALSE, variant: real[real: real]], ref: NIL ]]; }; AnyFromBool: PUBLIC PROC [bool: BOOL] RETURNS [Any] ~ { RETURN [[ val: [executable: FALSE, variant: boolean[bool: bool]], ref: NIL ]]; }; AnyFromArray: PUBLIC PROC [array: Array] RETURNS [Any] ~ { RETURN [[val: array.val, ref: array.ref]]; }; AnyFromString: PUBLIC PROC [string: String] RETURNS [Any] ~ { RETURN [[val: string.val, ref: string.ref]]; }; AnyFromName: PUBLIC PROC [name: Name] RETURNS [Any] ~ { RETURN [[val: name.val, ref: name.ref]]; }; AnyFromDict: PUBLIC PROC [dict: Dict] RETURNS [Any] ~ { RETURN [[val: dict.val, ref: dict.ref]]; }; AnyFromFile: PUBLIC PROC [file: File] RETURNS [Any] ~ { RETURN [[val: file.val, ref: file.ref]]; }; Eq: PUBLIC PROC [x1, x2: Any] RETURNS [BOOL] ~ { WITH v1: x1.val SELECT FROM null => WITH v2: x2.val SELECT FROM null => RETURN [TRUE]; ENDCASE; integer => WITH v2: x2.val SELECT FROM integer => RETURN [v1.int=v2.int]; real => RETURN [v1.int=v2.real]; ENDCASE; real => WITH v2: x2.val SELECT FROM integer => RETURN [v1.real=v2.int]; real => RETURN [v1.real=v2.real]; ENDCASE; boolean => WITH v2: x2.val SELECT FROM boolean => RETURN [v1.bool=v2.bool]; ENDCASE; operator => WITH v2: x2.val SELECT FROM operator => RETURN [x1.ref=x2.ref]; ENDCASE; array => WITH v2: x2.val SELECT FROM array => RETURN [x1.ref=x2.ref AND v1.start=v2.start AND v1.length=v2.length]; ENDCASE; string => WITH v2: x2.val SELECT FROM string => RETURN [StringEq[StringFromAny[x1], StringFromAny[x2]]]; name => RETURN [StringEq[StringFromAny[x1], NameFromAny[x2].ref^]]; ENDCASE; file => WITH v2: x2.val SELECT FROM file => RETURN [x1.ref=x2.ref]; ENDCASE; name => WITH v2: x2.val SELECT FROM name => RETURN [x1.ref=x2.ref]; string => RETURN [StringEq[NameFromAny[x1].ref^, StringFromAny[x2]]]; ENDCASE; dict => WITH v2: x2.val SELECT FROM dict => RETURN [x1.ref=x2.ref]; ENDCASE; mark => WITH v2: x2.val SELECT FROM mark => RETURN [TRUE]; ENDCASE; font => WITH v2: x2.val SELECT FROM font => RETURN [x1.ref=x2.ref]; ENDCASE; ENDCASE; RETURN [FALSE]; }; CharFromInt: PUBLIC PROC [int: INT] RETURNS [CHAR] ~ { CharRange: TYPE ~ CARDINAL[0..CHAR.LAST.ORD]; IF int IN CharRange THEN RETURN [VAL[CharRange[int]]]; ERROR Error[rangecheck]; }; IntFromReal: PUBLIC PROC [real: REAL] RETURNS [INT] ~ { RETURN [Real.Fix[real ! Real.RealException => CONTINUE]]; ERROR Error[rangecheck]; }; IntFromString: PUBLIC PROC [string: String] RETURNS [INT] ~ { found: BOOL; token: Any; post: String; [found, token, post] _ StringToken[string]; SELECT Type[token] FROM integer => RETURN [IntFromAny[token]]; real => RETURN [IntFromReal[RealFromAny[token]]]; ENDCASE => ERROR Error[typecheck]; }; RealFromString: PUBLIC PROC [string: String] RETURNS [REAL] ~ { found: BOOL; token: Any; post: String; [found, token, post] _ StringToken[string]; SELECT Type[token] FROM integer => RETURN [RealFromInt[IntFromAny[token]]]; real => RETURN [RealFromAny[token]]; ENDCASE => ERROR Error[typecheck]; }; StringFromInt: PUBLIC PROC [int, radix: INT, string: String] RETURNS [substring: String] ~ { negative: BOOL ~ (int<0); val: CARD _ ABS[INT]; stack: ARRAY [0..32] OF CHAR; length: NAT _ 0; base: NAT _ 0; IF radix IN [2..36] THEN base _ radix ELSE ERROR Error[rangecheck]; DO digit: NAT ~ val MOD base; stack[length] _ IF digit<10 THEN '0+digit ELSE 'A+(digit-10); length _ length + 1; IF val