<> <> <> <> <<>> DIRECTORY PS; PSPolyImpl: CEDAR PROGRAM IMPORTS PS ~ BEGIN OPEN PS; <> Pcopy: PROC [self: Root] ~ { arg: Any ~ PopAny[self]; SELECT Type[arg] FROM integer => { n: INT ~ IntFromAny[arg]; Copy[self, n]; }; array => { array2: Array ~ ArrayFromAny[arg]; array1: Array ~ PopArray[self]; IF ArrayAccess[array1] { string2: String ~ StringFromAny[arg]; string1: String ~ PopString[self]; IF StringAccess[string1] { dict2: Dict ~ DictFromAny[arg]; dict1: Dict ~ PopDict[self]; IF DictAccess[dict1] ERROR Error[typecheck]; }; Plength: PROC [self: Root] ~ { arg: Any ~ PopAny[self]; SELECT Type[arg] FROM array => { array: Array ~ ArrayFromAny[arg]; IF ArrayAccess[array] { string: String ~ StringFromAny[arg]; IF StringAccess[string] { dict: Dict ~ DictFromAny[arg]; IF DictAccess[dict] { name: Name ~ NameFromAny[arg]; PushInt[self, NameLength[name]]; }; ENDCASE => ERROR Error[typecheck]; }; Pget: PROC [self: Root] ~ { arg2: Any ~ PopAny[self]; arg1: Any ~ PopAny[self]; SELECT Type[arg1] FROM array => { array: Array ~ ArrayFromAny[arg1]; index: INT ~ IntFromAny[arg2]; IF ArrayAccess[array] { string: String ~ StringFromAny[arg1]; index: INT ~ IntFromAny[arg2]; IF StringAccess[string] { dict: Dict ~ DictFromAny[arg1]; IF DictAccess[dict] ERROR Error[typecheck]; }; Pput: PROC [self: Root] ~ { arg3: Any ~ PopAny[self]; arg2: Any ~ PopAny[self]; arg1: Any ~ PopAny[self]; SELECT Type[arg1] FROM array => { array: Array ~ ArrayFromAny[arg1]; index: INT ~ IntFromAny[arg2]; IF ArrayAccess[array] { string: String ~ StringFromAny[arg1]; index: INT ~ IntFromAny[arg2]; int: INT ~ IntFromAny[arg3]; IF StringAccess[string] { dict: Dict ~ DictFromAny[arg1]; IF DictAccess[dict] ERROR Error[typecheck]; }; Pgetinterval: PROC [self: Root] ~ { count: INT ~ PopInt[self]; index: INT ~ PopInt[self]; arg1: Any ~ PopAny[self]; SELECT Type[arg1] FROM array => { array: Array ~ ArrayFromAny[arg1]; IF ArrayAccess[array] { string: String ~ StringFromAny[arg1]; IF StringAccess[string] ERROR Error[typecheck]; }; Pputinterval: PROC [self: Root] ~ { arg3: Any ~ PopAny[self]; index: INT ~ PopInt[self]; arg1: Any ~ PopAny[self]; SELECT Type[arg1] FROM array => { array1: Array ~ ArrayFromAny[arg1]; array2: Array ~ ArrayFromAny[arg3]; IF ArrayAccess[array1] { string1: String ~ StringFromAny[arg1]; string2: String ~ StringFromAny[arg3]; IF StringAccess[string1] ERROR Error[typecheck]; }; Pforall: PROC [self: Root] ~ { proc: Any ~ PopAny[self]; arg: Any ~ PopAny[self]; SELECT Type[arg] FROM array => { array: Array ~ ArrayFromAny[arg]; action: PROC [x: Any] ~ { PushAny[self, x]; Execute[self, proc]; }; IF ArrayAccess[array] CONTINUE]; }; string => { string: String ~ StringFromAny[arg]; action: PROC [c: CHAR] ~ { PushInt[self, IntFromChar[c]]; Execute[self, proc]; }; IF StringAccess[string] CONTINUE]; }; dict => { dict: Dict ~ DictFromAny[arg]; action: PROC [key, val: Any] ~ { PushAny[self, key]; PushAny[self, val]; Execute[self, proc]; }; IF DictAccess[dict] CONTINUE]; }; ENDCASE => ERROR Error[typecheck]; }; PolyPrimitives: PROC [self: Root] ~ { Register[self, "copy", Pcopy]; Register[self, "length", Plength]; Register[self, "get", Pget]; Register[self, "put", Pput]; Register[self, "getinterval", Pgetinterval]; Register[self, "putinterval", Pputinterval]; Register[self, "forall", Pforall]; }; RegisterPrimitives[PolyPrimitives]; END.