<> <> <> <> <<>> DIRECTORY Atom, PS, RefText, Rope; PS2Impl: CEDAR PROGRAM IMPORTS Atom, PS, RefText, Rope ~ BEGIN OPEN PS; ROPE: TYPE ~ Rope.ROPE; <> ArrayNew: PUBLIC PROC [size: INT] RETURNS [Array] ~ { IF size IN ArrayIndex THEN { base: ArrayBase ~ NEW[ArrayBaseRep[size]]; RETURN[[executable: FALSE, access: unlimited, start: 0, length: size, base: base]]; } ELSE ERROR Error[IF size<0 THEN rangecheck ELSE limitcheck]; }; ArrayTransfer: PUBLIC PROC [to: ArrayBase, toStart: ArrayIndex, from: ArrayBase, fromStart: ArrayIndex, length: ArrayIndex] ~ { FOR i: ArrayIndex IN[0..length) DO to[toStart+i] _ from[fromStart+i]; ENDLOOP; }; ArrayGet: PUBLIC PROC [array: Array, index: INT] RETURNS [Any] ~ { IF index NOT IN[0..array.length) THEN ERROR Error[rangecheck]; RETURN [array.base[array.start+index]]; }; ArrayPut: PUBLIC PROC [array: Array, index: INT, x: Any] ~ { IF index NOT IN[0..array.length) THEN ERROR Error[rangecheck]; array.base[array.start+index] _ x; }; ArrayGetInterval: PUBLIC PROC [array: Array, index, count: INT] RETURNS [Array] ~ { IF index NOT IN[0..array.length] THEN ERROR Error[rangecheck]; IF count NOT IN[0..array.length-index] THEN ERROR Error[rangecheck]; RETURN [[executable: array.executable, access: array.access, start: array.start+index, length: count, base: array.base]]; }; ArrayPutInterval: PUBLIC PROC [array: Array, index: INT, interval: Array] ~ { IF index NOT IN[0..array.length] THEN ERROR Error[rangecheck]; IF interval.length NOT IN[0..array.length-index] THEN ERROR Error[rangecheck]; ArrayTransfer[to: array.base, toStart: array.start+index, from: interval.base, fromStart: interval.start, length: interval.length]; }; ArrayCopy: PUBLIC PROC [array1, array2: Array] RETURNS [Array] ~ { subarray2: Array ~ ArrayGetInterval[array2, 0, array1.length]; ArrayPutInterval[subarray2, 0, array1]; RETURN [subarray2]; }; ArrayStore: PUBLIC PROC [stack: Stack, array: Array] ~ { IF stack.count> StringNew: PUBLIC PROC [size: INT] RETURNS [String] ~ { IF size IN StringIndex THEN { base: StringBase ~ NEW[TEXT[size]]; RETURN[[executable: FALSE, access: unlimited, start: 0, length: size, base: base]]; } ELSE ERROR Error[IF size<0 THEN rangecheck ELSE limitcheck]; }; StringTransfer: PROC [to: StringBase, toStart: StringIndex, from: StringBase, fromStart: StringIndex, length: StringIndex] ~ { FOR i: StringIndex IN[0..length) DO to[toStart+i] _ from[fromStart+i]; <<***** use ByteBlt here ? *****>> ENDLOOP; }; StringGet: PUBLIC PROC [string: String, index: INT] RETURNS [INT] ~ { IF index NOT IN[0..string.length) THEN ERROR Error[rangecheck]; RETURN [ORD[string.base[string.start+index]]]; }; StringPut: PUBLIC PROC [string: String, index: INT, x: INT] ~ { IF index NOT IN[0..string.length) THEN ERROR Error[rangecheck]; IF x NOT IN[0..256) THEN ERROR Error[rangecheck]; string.base[string.start+index] _ VAL[CARDINAL[x]]; }; StringGetInterval: PUBLIC PROC [string: String, index, count: INT] RETURNS [String] ~ { IF index NOT IN[0..string.length] THEN ERROR Error[rangecheck]; IF count NOT IN[0..string.length-index] THEN ERROR Error[rangecheck]; RETURN [[executable: string.executable, access: string.access, start: string.start+index, length: count, base: string.base]]; }; StringPutInterval: PUBLIC PROC [string: String, index: INT, interval: String] ~ { IF index NOT IN[0..string.length] THEN ERROR Error[rangecheck]; IF interval.length NOT IN[0..string.length-index] THEN ERROR Error[rangecheck]; StringTransfer[to: string.base, toStart: string.start+index, from: interval.base, fromStart: interval.start, length: interval.length]; }; StringCopy: PUBLIC PROC [string1, string2: String] RETURNS [String] ~ { substring2: String ~ StringGetInterval[string2, 0, string1.length]; StringPutInterval[substring2, 0, string1]; RETURN [substring2]; }; StringFromRope: PROC [rope: ROPE] RETURNS [String] ~ { string: String ~ StringNew[Rope.Size[rope]]; FOR i: NAT IN[0..string.length) DO string.base[i] _ Rope.Fetch[rope, i]; ENDLOOP; RETURN [string]; }; AtomFromString: PROC [string: String] RETURNS [atom: ATOM] ~ { scratch: REF TEXT ~ RefText.ObtainScratch[string.length]; text: REF TEXT _ scratch; text _ RefText.Append[to: text, from: string.base, start: string.start, len: string.length]; atom _ Atom.MakeAtomFromRefText[text]; RefText.ReleaseScratch[scratch]; }; <> NameFromRope: PROC [rope: ROPE, executable: BOOL _ TRUE] RETURNS [Name] ~ { atom: ATOM ~ Atom.MakeAtom[rope]; RETURN [[executable, atom]]; }; NameFromString: PROC [string: String, executable: BOOL _ TRUE] RETURNS [Name] ~ { atom: ATOM ~ AtomFromString[string]; RETURN [[executable, atom]]; }; NameToString: PROC [name: Name, string: String] RETURNS [String] ~ { rope: ROPE ~ Atom.GetPName[name.atom]; result: String ~ StringGetInterval[string, 0, Rope.Size[rope]]; FOR i: NAT IN[0..result.length) DO result.base[result.start+i] _ Rope.Fetch[rope, i]; ENDLOOP; RETURN [result]; }; <> Parray: PROC [self: Root] ~ { size: INT ~ PopInt[self.ostack]; PushArray[self.ostack, ArrayNew[size]]; }; Pstartarray: PROC [self: Root] ~ { -- [ PushMark[self.ostack]; }; Pendarray: PROC [self: Root] ~ { -- ] size: INT ~ CountToMark[self.ostack]; array: Array ~ ArrayNew[size]; ArrayStore[self.ostack, array]; PopMark[self.ostack]; PushArray[self.ostack, array]; }; Paload: PROC [self: Root] ~ { array: Array ~ PopArray[self.ostack]; IF array.access found _ TRUE; ENDLOOP; }; IF found THEN { match: String ~ StringGetInterval[string, 0, seek.length]; post: String ~ StringGetInterval[string, seek.length, string.length-seek.length]; PushString[self.ostack, post]; PushString[self.ostack, match]; PushBool[self.ostack, TRUE]; } ELSE { PushString[self.ostack, string]; PushBool[self.ostack, FALSE]; }; }; Psearch: PROC [self: Root] ~ { seek: String ~ PopString[self.ostack]; string: String ~ PopString[self.ostack]; found: BOOL _ FALSE; skip: StringIndex _ 0; IF string.access found _ TRUE; ENDLOOP; ENDLOOP; IF found THEN { pre: String ~ StringGetInterval[string, 0, skip]; match: String ~ StringGetInterval[string, skip, seek.length]; post: String ~ StringGetInterval[string, skip+seek.length, string.length-(skip+seek.length)]; PushString[self.ostack, post]; PushString[self.ostack, match]; PushString[self.ostack, pre]; PushBool[self.ostack, TRUE]; } ELSE { PushString[self.ostack, string]; PushBool[self.ostack, FALSE]; }; }; Plength: PROC [self: Root] ~ { x: Any ~ Pop[self.ostack]; length: INT _ 1; SELECT Type[x] FROM array => { array: Array ~ ArrayFromAny[x]; IF array.access { string: String ~ StringFromAny[x]; IF string.access { dict: Dict ~ DictFromAny[x]; IF dict.base.access { array: Array ~ ArrayFromAny[x]; i: INT ~ IntFromAny[index]; IF array.access { string: String ~ StringFromAny[x]; i: INT ~ IntFromAny[index]; IF string.access { dict: Dict ~ DictFromAny[x]; IF dict.base.access ERROR Error[typecheck]; }; Pput: PROC [self: Root] ~ { val: Any ~ Pop[self.ostack]; key: Any ~ Pop[self.ostack]; x: Any ~ Pop[self.ostack]; SELECT Type[x] FROM array => { array: Array ~ ArrayFromAny[x]; index: INT ~ IntFromAny[key]; IF array.access { string: String ~ StringFromAny[x]; index: INT ~ IntFromAny[key]; int: INT ~ IntFromAny[val]; IF string.access { dict: Dict ~ DictFromAny[x]; IF dict.base.access ERROR Error[typecheck]; }; Pgetinterval: PROC [self: Root] ~ { count: INT ~ PopInt[self.ostack]; index: INT ~ PopInt[self.ostack]; x: Any ~ Pop[self.ostack]; SELECT Type[x] FROM array => { array: Array ~ ArrayFromAny[x]; IF array.access { string: String ~ StringFromAny[x]; IF string.access ERROR Error[typecheck]; }; Pputinterval: PROC [self: Root] ~ { x2: Any ~ Pop[self.ostack]; index: INT ~ PopInt[self.ostack]; x1: Any ~ Pop[self.ostack]; SELECT Type[x1] FROM array => { array1: Array ~ ArrayFromAny[x1]; array2: Array ~ ArrayFromAny[x2]; IF array1.access { string1: String ~ StringFromAny[x1]; string2: String ~ StringFromAny[x2]; IF string1.access ERROR Error[typecheck]; }; Pcopy: PROC [self: Root] ~ { x2: Any ~ Pop[self.ostack]; SELECT Type[x2] FROM integer => { n: INT ~ IntFromAny[x2]; Copy[self.ostack, n]; }; array => { array2: Array ~ ArrayFromAny[x2]; array1: Array ~ PopArray[self.ostack]; IF array1.access { string2: String ~ StringFromAny[x2]; string1: String ~ PopString[self.ostack]; IF string1.access { dict2: Dict ~ DictFromAny[x2]; dict1: Dict ~ PopDict[self.ostack]; IF dict1.base.access ERROR Error[typecheck]; }; Register2: PROC [self: Root] ~ { Register[self, "array", Parray]; Register[self, "[", Pstartarray]; Register[self, "]", Pendarray]; Register[self, "aload", Paload]; Register[self, "astore", Pastore]; Register[self, "string", Pstring]; Register[self, "anchorsearch", Panchorsearch]; Register[self, "search", Psearch]; Register[self, "length", Plength]; Register[self, "get", Pget]; Register[self, "put", Pput]; Register[self, "getinterval", Pgetinterval]; Register[self, "putinterval", Pputinterval]; Register[self, "copy", Pcopy]; }; RegisterPrimitives[Register2]; END.