<> <> <> <> <<>> DIRECTORY PS, Basics, Convert, EditedStream, IO, Real, SafeStorage; PSLanguage1Impl: CEDAR PROGRAM IMPORTS PS, Basics, Convert, EditedStream, IO, Real, SafeStorage EXPORTS PS ~ BEGIN OPEN PS; <> TextFromTypeArray: TYPE ~ ARRAY TypeCode OF Text; textFromType: REF TextFromTypeArray ~ NEW [TextFromTypeArray _ [ null: "nulltype", integer: "integertype", real: "realtype", boolean: "booleantype", array: "arraytype", string: "stringtype", name: "nametype", dict: "dicttype", operator: "operatortype", file: "filetype", mark: "marktype", save: "savetype", font: "fonttype" ]]; NameFromType: PUBLIC PROC [self: Root, type: TypeCode] RETURNS [Name] ~ { RETURN [NameFromText[self, textFromType[type]]]; }; 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]; }; 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, access: Access] RETURNS [Array] ~ { WITH val: x.val SELECT FROM array => WITH x.ref SELECT FROM ref: ArrayRef => { IF val.access ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; StringFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [String] ~ { WITH val: x.val SELECT FROM string => WITH x.ref SELECT FROM ref: StringRef => { IF val.access ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; DictFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [Dict] ~ { WITH val: x.val SELECT FROM dict => WITH x.ref SELECT FROM ref: DictRef => { IF ref.access ERROR Bug; ENDCASE => ERROR Error[typecheck]; }; FileFromAny: PUBLIC PROC [x: Any, access: Access] RETURNS [File] ~ { WITH val: x.val SELECT FROM file => WITH x.ref SELECT FROM ref: FileRef => { IF val.access 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]; }; 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]]; }; 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]]; }; AnyFromName: PUBLIC PROC [name: Name] RETURNS [Any] ~ { RETURN [[val: name.val, ref: name.ref]]; }; AnyFromOperator: PUBLIC PROC [op: Operator] RETURNS [Any] ~ { RETURN [[val: op.val, ref: op.ref]]; }; <> PushAny: PUBLIC PROC [self: Root, x: Any] ~ { IF NOT self.ocount0 THEN ERROR Error[stackunderflow]; self.ocount _ self.ocount-1; RETURN [self.ostack[self.ocount]]; }; InlinePopAny: PROC [self: Root] RETURNS [x: Any] ~ INLINE { IF NOT self.ocount>0 THEN ERROR Error[stackunderflow]; self.ocount _ self.ocount-1; RETURN [self.ostack[self.ocount]]; }; PushInt: PUBLIC PROC [self: Root, int: INT] ~ { InlinePushAny[self, [val: [executable: FALSE, variant: integer[int: int]], ref: NIL]]; }; PushReal: PUBLIC PROC [self: Root, real: REAL] ~ { InlinePushAny[self, [val: [executable: FALSE, variant: real[real: real]], ref: NIL]]; }; PushBool: PUBLIC PROC [self: Root, bool: BOOL] ~ { InlinePushAny[self, [val: [executable: FALSE, variant: boolean[bool: bool]], ref: NIL]]; }; PushArray: PUBLIC PROC [self: Root, array: Array] ~ { PushAny[self, [val: array.val, ref: array.ref]]; }; PushString: PUBLIC PROC [self: Root, string: String] ~ { PushAny[self, [val: string.val, ref: string.ref]]; }; PushDict: PUBLIC PROC [self: Root, dict: Dict] ~ { PushAny[self, [val: dict.val, ref: dict.ref]]; }; PushFile: PUBLIC PROC [self: Root, file: File] ~ { PushAny[self, [val: file.val, ref: file.ref]]; }; PushName: PUBLIC PROC [self: Root, name: Name] ~ { PushAny[self, [val: name.val, ref: name.ref]]; }; PushLevel: PUBLIC PROC [self: Root, level: Level] ~ { PushAny[self, [val: [executable: FALSE, variant: save[level]], ref: NIL]]; }; PopInt: PUBLIC PROC [self: Root] RETURNS [INT] ~ { x: Any ~ InlinePopAny[self]; WITH val: x.val SELECT FROM integer => RETURN [val.int]; ENDCASE => ERROR Error[typecheck]; }; PopReal: PUBLIC PROC [self: Root] RETURNS [REAL] ~ { x: Any ~ InlinePopAny[self]; WITH val: x.val SELECT FROM integer => RETURN [REAL[val.int]]; real => RETURN [val.real]; ENDCASE => ERROR Error[typecheck]; }; PopBool: PUBLIC PROC [self: Root] RETURNS [BOOL] ~ { x: Any ~ InlinePopAny[self]; WITH val: x.val SELECT FROM boolean => RETURN [val.bool]; ENDCASE => ERROR Error[typecheck]; }; PopArray: PUBLIC PROC [self: Root, access: Access] RETURNS [Array] ~ { RETURN [ArrayFromAny[PopAny[self], access]]; }; PopString: PUBLIC PROC [self: Root, access: Access] RETURNS [String] ~ { RETURN [StringFromAny[PopAny[self], access]]; }; PopDict: PUBLIC PROC [self: Root, access: Access] RETURNS [Dict] ~ { RETURN [DictFromAny[PopAny[self], access]]; }; PopFile: PUBLIC PROC [self: Root, access: Access] RETURNS [File] ~ { RETURN [FileFromAny[PopAny[self], access]]; }; PopName: PUBLIC PROC [self: Root] RETURNS [Name] ~ { RETURN [NameFromAny[PopAny[self]]]; }; PopOperator: PUBLIC PROC [self: Root] RETURNS [Operator] ~ { RETURN [OperatorFromAny[PopAny[self]]]; }; PopLevel: PUBLIC PROC [self: Root] RETURNS [Level] ~ { x: Any ~ InlinePopAny[self]; WITH val: x.val SELECT FROM save => RETURN [val.level]; ENDCASE => ERROR Error[typecheck]; }; PopProc: PUBLIC PROC [self: Root] RETURNS [Any] ~ { x: Any ~ PopAny[self]; SELECT Type[x] FROM array => RETURN [x]; ENDCASE => ERROR Error[typecheck]; }; PushMark: PUBLIC PROC [self: Root] ~ { PushAny[self, [val: [executable: FALSE, variant: mark[]], ref: NIL]]; }; PopMark: PUBLIC PROC [self: Root] ~ { x: Any ~ PopAny[self]; SELECT Type[x] FROM mark => NULL; ENDCASE => ERROR Error[typecheck]; }; Copy: PUBLIC PROC [self: Root, n: INT] ~ { IF n<0 THEN ERROR Error[rangecheck]; IF n>self.ocount THEN ERROR Error[stackunderflow]; IF n>(self.osize-self.ocount) THEN ERROR Error[stackoverflow]; FOR i: ArrayIndex IN [self.ocount..ArrayIndex[self.ocount+n]) DO self.ostack[i] _ self.ostack[i-n]; ENDLOOP; self.ocount _ self.ocount+n; }; Roll: PUBLIC PROC [self: Root, n, j: INT] ~ { IF n<0 THEN ERROR Error[rangecheck]; IF n>self.ocount THEN ERROR Error[stackunderflow]; IF j NOT IN [0..n) THEN { j _ j MOD n; IF j<0 THEN j _ j+n }; IF j#0 THEN { Reverse: PROC [ostack: OStack, m1, m2: StackIndex] ~ { FOR i: StackIndex IN[0..(m2-m1)/2) DO i1: StackIndex ~ m1+i; i2: StackIndex ~ m2-1-i; x1: Any ~ ostack[i1]; x2: Any ~ ostack[i2]; ostack[i1] _ x2; ostack[i2] _ x1; ENDLOOP; }; k3: StackIndex ~ self.ocount; k2: StackIndex ~ k3-j; k1: StackIndex ~ k3-n; IF (k2-k1)>1 THEN Reverse[self.ostack, k1, k2]; IF (k3-k2)>1 THEN Reverse[self.ostack, k2, k3]; IF (k3-k1)>1 THEN Reverse[self.ostack, k1, k3]; }; }; Index: PUBLIC PROC [self: Root, n: INT] RETURNS [Any] ~ { IF n<0 THEN ERROR Error[rangecheck]; IF NOT n> self.ocount _ 0; }; ClearToMark: PUBLIC PROC [self: Root] ~ { FOR i: StackIndex DECREASING IN [0..self.ocount) DO IF self.ostack[i].val.type=mark THEN { self.ocount _ i; RETURN }; ENDLOOP; ERROR Error[unmatchedmark]; }; CountToMark: PUBLIC PROC [self: Root] RETURNS [StackIndex] ~ { FOR i: ArrayIndex DECREASING IN [0..self.ocount) DO IF self.ostack[i].val.type=mark THEN RETURN [self.ocount-1-i]; ENDLOOP; ERROR Error[unmatchedmark]; }; TypeIndex: PUBLIC PROC [self: Root, n: StackIndex] RETURNS [TypeCode] ~ { IF NOT n> Ceiling: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ { z _ Real.Ceiling[x ! Real.RealException => GOTO Big]; EXITS Big => RETURN [x]; }; Floor: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ { z _ Real.Floor[x ! Real.RealException => GOTO Big]; EXITS Big => RETURN [x]; }; Round: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ { RETURN [Floor[x+0.5]]; }; Truncate: PUBLIC PROC [x: REAL] RETURNS [z: REAL] ~ { z _ Real.Fix[x ! Real.RealException => GOTO Big]; EXITS Big => RETURN [x]; }; Rand: PUBLIC PROC [self: Root] RETURNS [INT] ~ { RETURN [0]; }; SRand: PUBLIC PROC [self: Root, seed: INT] ~ { }; RRand: PUBLIC PROC [self: Root] RETURNS [INT] ~ { RETURN [0]; }; <> 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 => { string1: String ~ StringFromAny[x1, readOnly]; string2: String ~ StringFromAny[x2, readOnly]; RETURN [StringEq[string1, string2]]; }; name => { string1: String ~ StringFromAny[x1, readOnly]; string2: String ~ NameFromAny[x2].ref.string; RETURN [StringEq[string1, string2]]; }; 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 => { string1: String ~ NameFromAny[x1].ref.string; string2: String ~ StringFromAny[x2, readOnly]; RETURN [StringEq[string1, string2]]; }; 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]; }; Compare: PUBLIC PROC [x1, x2: Any] RETURNS [Comparison] ~ { WITH v1: x1.val SELECT FROM integer => WITH v2: x2.val SELECT FROM integer => RETURN [Basics.CompareInt[v1.int, v2.int]]; real => RETURN [Real.CompareREAL[v1.int, v2.real]]; ENDCASE; real => WITH v2: x2.val SELECT FROM integer => RETURN [Real.CompareREAL[v1.real, v2.int]]; real => RETURN [Real.CompareREAL[v1.real, v2.real]]; ENDCASE; string => WITH v2: x2.val SELECT FROM string => { string1: String ~ StringFromAny[x1, readOnly]; string2: String ~ StringFromAny[x2, readOnly]; RETURN [StringCompare[string1, string2]]; }; ENDCASE; ENDCASE; ERROR Error[typecheck]; }; <> CharFromInt: PUBLIC PROC [int: INT] RETURNS [CHAR] ~ { CharRange: TYPE ~ [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[NIL, 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[NIL, string]; <> <> SELECT Type[token] FROM integer => RETURN [RealFromInt[IntFromAny[token]]]; real => RETURN [RealFromAny[token]]; ENDCASE => ERROR Error[typecheck]; }; StringFromInt: PUBLIC PROC [self: Root, string: String, int, radix: INT] RETURNS [String] ~ { text: MutableText ~ self.buffer; -- assume maxLength>=32 start: NAT _ text.length _ text.maxLength; -- result is in text[start..maxLength) base: NAT ~ IF radix IN [2..36] THEN radix ELSE ERROR Error[rangecheck]; minus: BOOL ~ base=10 AND int<0; -- only base 10 numbers are signed val: CARD _ LOOPHOLE[IF minus THEN -int ELSE int]; DO digit: [0..36) ~ val MOD base; text[start _ start-1] _ IF digit<10 THEN '0+digit ELSE 'A+(digit-10); IF val> <> <> <> <> <> <> <<};>> <<>> <> Error: PUBLIC ERROR [error: ErrorCode] ~ CODE; Bug: PUBLIC ERROR ~ CODE; CurrentFile: PUBLIC SIGNAL RETURNS [File] ~ CODE; Exit: PUBLIC SIGNAL ~ CODE; Stop: PUBLIC ERROR ~ CODE; Quit: PUBLIC ERROR ~ CODE; TextFromErrorArray: TYPE ~ ARRAY ErrorCode OF Text; textFromError: REF TextFromErrorArray ~ NEW [TextFromErrorArray _ [ dictfull: "dictfull", dictstackoverflow: "dictstackoverflow", dictstackunderflow: "dictstackunderflow", execstackoverflow: "execstackoverflow", interrupt: "interrupt", invalidaccess: "invalidaccess", invalidexit: "invalidexit", invalidfileaccess: "invalidfileaccess", invalidfont: "invalidfont", invalidrestore: "invalidrestore", ioerror: "ioerror", limitcheck: "limitcheck", nocurrentpoint: "nocurrentpoint", rangecheck: "rangecheck", stackoverflow: "stackoverflow", stackunderflow: "stackunderflow", syntaxerror: "syntaxerror", timeout: "timeout", typecheck: "typecheck", undefined: "undefined", undefinedfilename: "undefinedfilename", undefinedresult: "undefinedresult", unimplemented: "unimplemented", unmatchedmark: "unmatchedmark", unregistered: "unregistered", VMerror: "VMerror" ]]; ExecuteArray: PROC [self: Root, array: Array] ~ { action: PROC [x: Any] ~ { Execute[self, x, TRUE] }; ArrayForAll[array, action]; }; ExecuteString: PROC [self: Root, string: String] ~ { post: String _ string; DO found: BOOL; token: Any; [found, token, post] _ StringToken[self, post]; IF found THEN Execute[self, token, TRUE] ELSE EXIT; ENDLOOP; }; ExecuteFile: PROC [self: Root, file: File] ~ { ENABLE CurrentFile => RESUME [file]; DO found: BOOL; token: Any; [found, token] _ FileToken[self, file]; IF found THEN Execute[self, token, TRUE] ELSE EXIT; ENDLOOP; }; EStackOverflow: ERROR ~ CODE; Execute: PUBLIC PROC [self: Root, x: Any, directly: BOOL _ FALSE] ~ { innerExecute: PROC [self: Root, x: Any] ~ { IF x.val.executable THEN WITH val: x.val SELECT FROM operator => WITH x.ref SELECT FROM ref: OperatorRef => ref.proc[self]; ENDCASE => ERROR Bug; < (self.procFromOperator[val.index])[self];>> name => Execute[self, Load[self, x]]; array => IF directly THEN PushAny[self, x] -- defer execution of procedure ELSE ExecuteArray[self, ArrayFromAny[x, executeOnly]]; string => ExecuteString[self, StringFromAny[x, executeOnly]]; file => ExecuteFile[self, FileFromAny[x, executeOnly]]; null => NULL; ENDCASE => PushAny[self, x] -- other types are always literal ELSE PushAny[self, x]; -- literal }; savedCount: ArrayIndex ~ self.ocount; errorCaught: BOOL _ FALSE; errorCode: ErrorCode; IF NOT self.ecount { errorCaught _ TRUE; errorCode _ error; CONTINUE }]; self.ecount _ self.ecount-1; IF errorCaught THEN { errorText: Text ~ textFromError[errorCode]; errorName: Name ~ NameFromText[self, errorText]; errorHandler: Any ~ DictGet[self.errordict, AnyFromName[errorName]]; self.ocount _ savedCount; -- restore ostack PushAny[self, x]; -- ***** what if stackoverflow here? Execute[self, errorHandler]; }; }; <> InitializationList: TYPE ~ LIST OF PROC [Root]; initializationHead, initializationTail: InitializationList _ NIL; NoteInitialization: PUBLIC PROC [initialization: PROC [Root]] ~ { list: InitializationList _ LIST [initialization]; IF initializationHead=NIL THEN initializationHead _ list ELSE initializationTail.rest _ list; initializationTail _ list; }; DoInitialization: PROC [self: Root] ~ { FOR list: InitializationList _ initializationHead, list.rest UNTIL list=NIL DO list.first[self]; ENDLOOP; }; Register: PUBLIC PROC [self: Root, text: Text, val: Any] ~ { key: Any ~ AnyFromName[NameFromText[self, text]]; Def[self, key, val]; }; RegisterOperator: PUBLIC PROC [self: Root, text: Text, proc: OperatorProc] ~ { operator: Operator ~ [ val: [executable: TRUE, variant: operator[]], ref: NEW [OperatorRep _ [proc: proc, text: text]] ]; Register[self, text, AnyFromOperator[operator]]; }; <> systemdictSize: INT ~ 256; userdictSize: INT ~ 200; errordictSize: INT ~ 28; nameDictSize: INT ~ 500; bufferSize: NAT ~ 200; Create: PUBLIC PROC [in, out: STREAM, osize: StackIndex _ 500, dsize: StackIndex _ 20, esize: StackIndex _ 250] ~ { self: Root ~ NEW [RootRep]; self.zone _ SafeStorage.GetSystemZone[]; self.buffer _ NEW[TEXT[bufferSize]]; self.ostack _ NEW[OStackRep[osize]]; self.osize _ osize; self.ocount _ 0; self.dstack _ NEW[DStackRep[dsize]]; self.dsize _ dsize; self.dcount _ 0; self.esize _ esize; self.ecount _ 0; self.restore _ NEW[RestoreStackRep _ ALL[NIL]]; self.level _ 0; self.systemdict _ DictCreate[self, systemdictSize]; self.userdict _ DictCreate[self, userdictSize]; self.errordict _ DictCreate[self, errordictSize]; self.nameDict _ DictCreate[self, nameDictSize]; self.stdin _ FileFromStream[self, in]; self.stdout _ FileFromStream[self, out]; self.stderr _ self.stdout; Begin[self, self.systemdict]; DoInitialization[self]; Register[self, "null", null]; Register[self, "true", AnyFromBool[TRUE]]; Register[self, "false", AnyFromBool[FALSE]]; Register[self, "systemdict", AnyFromDict[self.systemdict]]; Register[self, "userdict", AnyFromDict[self.userdict]]; Register[self, "errordict", AnyFromDict[self.errordict]]; Register[self, "version", AnyFromString[StringSetAccess[ StringCreateFromText[self, "38.0"], readOnly]]]; Begin[self, self.userdict]; Register[self, "start", CvX[AnyFromString[StringCreateFromText[self, "{prompt(%statementedit)(r)file cvx exec}loop"]]]]; Register[self, "prompt", CvX[AnyFromString[StringCreateFromText[self, "(*)print"]]]]; Execute[self, AnyFromName[NameFromText[self, "start"]] ! CurrentFile => RESUME [FileFromStream[self, IO.noInputStream]]; Exit => RESUME; Stop => RETRY; EditedStream.Rubout => { self.stdout.ref.stream.PutRope[" XXX\n"]; RETRY }; Quit => CONTINUE; ]; }; END.