DIRECTORY Rope, Atom, IO, Convert, MathExpr, MathConstructors, AlgebraClasses, Points; PointsImpl: CEDAR PROGRAM IMPORTS Rope, Atom, IO, Convert, MathConstructors, AlgebraClasses EXPORTS Points = BEGIN OPEN AC: AlgebraClasses, Points; SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE; BadElementStructure: PUBLIC ERROR [coordinateStructure: AC.Structure] = CODE; TypeError: PUBLIC ERROR [message: ATOM _ $Unspecified] = CODE; ClassPrintName: AC.PrintNameProc = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[Rope.Cat[ "Points of dimension ", Convert.RopeFromCard[data.dimension], " over ", data.coordinateStructure.class.printName[data.coordinateStructure] ] ]; }; ClassIsElementOf: AC.ElementOfProc = { IF NOT structure.class.structureEqual[structure, item.structure] THEN RETURN[FALSE]; RETURN[ TRUE ] }; ClassDimension: AC.StructureRankOp = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[data.dimension] }; ClassLegalFirstChar: AC.LegalFirstCharOp = { SELECT char FROM '[ , '(=> RETURN[TRUE]; ENDCASE; RETURN[FALSE]; }; ClassToExpr: AC.ToExprOp = { data: PointStructureData _ NARROW[in.structure.instanceData]; inData: PointData _ NARROW[in.data]; outRow: LIST OF MathExpr.EXPR _ NIL; FOR j:NAT DECREASING IN [1..data.dimension] DO outRow _ CONS[data.coordinateStructure.class.toExpr[inData[j] ], outRow]; ENDLOOP; out _ MathConstructors.MakeMatrix[1, data.dimension, LIST[outRow]]; }; pointStructureOps: PointOps _ NEW[PointOpsRec _ [ removeMainCoordinate: RemoveMainCood, mainCoordinate: MainCood ] ]; pointProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$PointStructure, pointStructureOps]]; pointStructureClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [ category: set, printName: ClassPrintName, structureEqual: AC.defaultStructureEqualityTest, isElementOf: ClassIsElementOf, legalFirstChar: ClassLegalFirstChar, read: Read, fromRope: FromRope, toRope: ToRope, write: Write, toExpr: ClassToExpr, equal: Equal, integralDomain: FALSE, gcdDomain: FALSE, euclideanDomain: FALSE, propList: LIST[pointProp] ] ]; MakePointStructure: PUBLIC PROC [coordinateStructure: AC.Structure, dimension: NAT] RETURNS [pointStructure: AC.Structure] ~ { pointStructureData: PointStructureData _ NEW[PointStructureDataRec _ [ coordinateStructure: coordinateStructure, dimension: dimension ] ]; RETURN[ NEW[AC.StructureRec _ [ class: pointStructureClass, instanceData: pointStructureData ] ] ]; }; IsPointStructure: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ { IF Atom.GetPropFromList[structure.class.propList, $PointStructure] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE]; }; RemoveMainCoordinate: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ { IF IsPointStructure[structure] THEN { pointOps: PointOps _ NARROW[ Atom.GetPropFromList[structure.class.propList, $PointStructure] ]; RETURN[pointOps.removeMainCoordinate]; } ELSE ERROR; }; MainCoordinate: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryOp] ~ { IF IsPointStructure[structure] THEN { pointOps: PointOps _ NARROW[ Atom.GetPropFromList[structure.class.propList, $PointStructure] ]; RETURN[pointOps.mainCoordinate]; } ELSE ERROR; }; Read: PUBLIC AC.ReadOp ~ { structureData: PointStructureData _ NARROW[structure.instanceData]; dimension: NAT _ structureData.dimension; outData: PointData _ NEW[PointDataRec[dimension] ]; coordinateStructure: AC.Structure _ structureData.coordinateStructure; puncChar: CHAR; out _ NEW[AC.ObjectRec _ [structure: structure, data: outData] ]; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; IF puncChar # '( AND puncChar # '[ THEN ERROR; []_ in.SkipWhitespace[]; FOR i:NAT IN [1 .. dimension] DO outData[i] _ coordinateStructure.class.read[in, coordinateStructure]; IF i < dimension THEN { []_ in.SkipWhitespace[]; IF in.PeekChar[]=', THEN [] _ in.GetChar[]; -- flush comma if present }; ENDLOOP; []_ in.SkipWhitespace[]; puncChar _ in.GetChar[]; IF puncChar # ') AND puncChar # '] THEN ERROR; []_ in.SkipWhitespace[]; }; FromRope: PUBLIC AC.FromRopeOp ~ { out _ Read[IO.RIS[in], structure]; }; ToRope: PUBLIC AC.ToRopeOp ~ { pointStructureData: PointStructureData _ NARROW[in.structure.instanceData]; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; inData: PointData _ NARROW[in.data]; out _ "( "; FOR i:NAT IN [1..inData.dimensionPlus1) DO out _ Rope.Concat[ out, coordinateStructure.class.toRope[inData[i] ] ]; IF i < inData.dimensionPlus1-1 THEN out _ Rope.Concat[out,", "]; ENDLOOP; out _ Rope.Concat[ out, " )" ]; }; Write: PUBLIC AC.WriteOp ~ { stream.PutRope[ ToRope[in] ] }; Equal: PUBLIC AC.EqualityOp ~ { data: PointStructureData _ NARROW[firstArg.structure.instanceData]; firstArgData: PointData _ NARROW[firstArg.data]; secondArgData: PointData _ NARROW[secondArg.data]; FOR j: INTEGER IN [1..data.dimension] DO IF NOT data.coordinateStructure.class.equal[firstArgData[j], secondArgData[j] ] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; RemoveMainCood: PUBLIC AC.UnaryOp ~ { pointStructureData: PointStructureData _ NARROW[arg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; PData: PointData _ NARROW[arg.data]; QData: PointData _ NEW[PointDataRec[dimension-1] ]; FOR i:NAT IN [1..dimension - 1] DO QData[i] _ PData[i] ENDLOOP; RETURN[ NEW[AC.ObjectRec _ [ structure: MakePointStructure[coordinateStructure, dimension-1], data: QData ] ] ]; }; MainCood: PUBLIC AC.UnaryOp ~ { pointStructureData: PointStructureData _ NARROW[arg.structure.instanceData]; dimension: NAT _ pointStructureData.dimension; coordinateStructure: AC.Structure _ pointStructureData.coordinateStructure; PData: PointData _ NARROW[arg.data]; QData: PointData _ NEW[PointDataRec[dimension-1] ]; QData[1] _ PData[dimension]; RETURN[ NEW[AC.ObjectRec _ [ structure: MakePointStructure[coordinateStructure, 1], data: QData ] ] ]; }; END. PointsImpl.mesa Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT Errors Class for Point Structures Assumes that if item is a point, then it really belongs to the domain pointed to by its structure field. ClassRead: AC.ReadOp = { RETURN[Read[in, structure] ]; }; ClassFromRope: AC.FromRopeOp = { stream: IO.STREAM _ IO.RIS[in]; RETURN[ ClassRead[stream, structure] ]; }; ClassToRope: AC.ToRopeOp = { point: Point _ NARROW[in]; RETURN[ ToRope[point] ] -- use defaults }; ClassWrite: AC.WriteOp = { point: Point _ NARROW[in]; IO.PutRope[stream, ClassToRope[point] ] }; ClassAdd: AC.BinaryOp = { firstPoint: Point _ NARROW[firstArg]; secondPoint: Point _ NARROW[secondArg]; IF NOT firstPoint.structure.class.structureEqual[firstPoint.structure, secondPoint.structure] THEN TypeError[]; RETURN[ Add[firstPoint, secondPoint] ] }; ClassNegate: AC.UnaryOp = { point: Point _ NARROW[arg]; RETURN[ Negate[point] ] }; ClassSubtract: AC.BinaryOp = { firstPoint: Point _ NARROW[firstArg]; secondPoint: Point _ NARROW[secondArg]; IF NOT firstPoint.structure.class.structureEqual[firstPoint.structure, secondPoint.structure] THEN TypeError[]; RETURN[ Subtract[firstPoint, secondPoint] ] }; ClassZero: AC.NullaryOp = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[ DiagPoint[data.coordinateStructure.class.zero[data.coordinateStructure], structure] ] }; ClassMultiply: AC.BinaryOp = { firstPoint: Point _ NARROW[firstArg]; secondPoint: Point _ NARROW[secondArg]; IF NOT firstPoint.structure.class.structureEqual[firstPoint.structure, secondPoint.structure] THEN TypeError[]; RETURN[ Multiply[firstPoint, secondPoint] ] }; ClassOne: AC.NullaryOp = { data: PointStructureData _ NARROW[structure.instanceData]; RETURN[ DiagPoint[data.coordinateStructure.class.one[data.coordinateStructure], structure] ] }; ClassEqual: AC.EqualityOp = { firstPoint: Point _ NARROW[firstArg]; secondPoint: Point _ NARROW[secondArg]; IF NOT firstArg.structure.class.structureEqual[firstArg.structure, secondPoint.structure] THEN TypeError[]; RETURN[ Equal[firstArg, secondPoint] ] }; ClassRemoveMainCoordinate: AC.UnaryOp = { point: Point _ NARROW[arg]; RETURN[ RemoveMainCood[point] ] }; ClassMainCoordinate: AC.UnaryOp = { point: Point _ NARROW[arg]; RETURN[ MainCood[point] ] }; characteristic: ClassCharacteristic, add: ClassAdd, negate: ClassNegate, subtract: ClassSubtract, zero: ClassZero, multiply: ClassMultiply, commutative: FALSE, one: ClassOne, Point Structure Constructor Extract Point Operations from Class Record Property Lists Conversion and IO Operations Э╩ ╥ШJЪЬЩJЩ3JЩЪ╧k Ш JЪЬШJШIcodeЪЭЬШKШKШ KШKЪЬШJЪЬШЧJШhead2ЪЬЭЬЭШJЪЭЬ ЭЬ,ШBJЪЭЬ ШJШЧJЪЭЬЭЬЭЬШ&headЩJЪ Ь ЭЬЭЬ ЭЬЭЬШ0JЪ ЬЭЬЭЬЭЬЭЬШMJЪ ЬЭЬЭЬЭЬЭЬШ>ЧЪЬЩЪ╧nЬЭЬШ$JЪЬЭЬШ:ЪЭЬ ШJШJЪЬ%Ш%JЪЬ Ш JЪЬBШBJЪЬШЧJШЧЪЮЬЭЬШ&JЩhJЪ ЭЬЭЬ;ЭЬЭЬЭЬШTJЪЭЬЭЬШJЪЬШЧЪЮЬЭЬШ&JЪЬЭЬШ:JЪЭЬШJЪЬШЧЪЮЬЭЬШ,ЪЭЬЭШKЪЬ ЭЬЭЬШKЪЭЬШЧKЪЭЬЭЬШJШЧЪЮ ЬЭЬЩJЪЭЬЩJЩЧЪЮ ЬЭЬЩ KЪ ЬЭЬЭЬЭЬЭЬЩKЪЭЬ!Щ'KЩЧЪЮЬЭЬ ЩJЪЬЭЬЩJЪЭЬ╧cЩ'JЩЧЪЮ ЬЭЬЩJЪЬЭЬЩJЪЭЬ%Щ'JЪЬЩЧЪЮЬЭЬ ШJЪЬЭЬШ=JЪЬЭЬ Ш$JЪ ЬЭЬЭЬ ЭЬЭЬШ$Ъ ЭЬЭЬЭ ЬЭЬЭШ.JЪЬ ЭЬ<ШIKЪЭЬШЧJЪЬ6ЭЬ ШDJЪЬШЧЪЮЬЭЬ ЩJЪЬЭЬЩ%JЪЬЭЬЩ'JЪЭЬЭЬXЭЬ ЩoJЪЭЬ Щ&JЪЬЩЧЪЮЬЭЬЩJЪЬЭЬЩJЪЭЬЩJЪЬЩЧЪЮ ЬЭЬ ЩJЪЬЭЬЩ%JЪЬЭЬЩ'JЪЭЬЭЬXЭЬ ЩoJЪЭЬ%Щ+JЪЬЩЧЪЮ ЬЭЬЩJЪЬЭЬЩ:JЪЭЬWЩ]JЪЬЩЧЪЮ ЬЭЬ ЩJЪЬЭЬЩ%JЪЬЭЬЩ'JЪЭЬЭЬXЭЬ ЩoJЪЭЬ%Щ+JЪЬЩЧЪЮЬЭЬЩJЪЬЭЬЩ:JЪЭЬVЩ\JЪЬЩЧЪЮ ЬЭЬЩJЪЬЭЬЩ%JЪЬЭЬЩ'JЪЭЬЭЬTЭЬ ЩkJЪЭЬ Щ&JЪЬЩЧЪЮЬЭЬЩ)JЪЬЭЬЩJЪЭЬЩJЪЬЩЧЪЮЬЭЬЩ#JЪЬЭЬЩJЪЭЬЩJЪЬЩЧЪЬЭЬШ1KЪЬ%Ш%KЪЬШKШЧKЪЬЭЬ<Ш\KЩЪ ЬЭЬЭЬЭЬЭЬШLJЪЬШJЪЬШKЪЬЭЬШ0JЪЬ$Щ$JШKЪЬШJШJЪЬ$Ш$JЪЬШJЪЬШJЪЬШJЪЬ Ш JЪЬШJШKЪЬЩKЪЬЩKЪЬЩKЪЬЩKШKЪЬЩKЪЬ ЭЬЩKЪЬЩKШKЪЬ Ш KШKЪЬЭЬШKЪЬЭЬШKЪЬЭЬШKШJЪЬ ЭЬШKШKШЧKШЧЪЬЩKШЪЮЬЭЬЭЬЭЬЭЬЭЬЭЬШ~ЪЬ)ЭЬШFKЪЬ)Ш)KЪЬШKЪЬШЧЪЭЬЭЬЭЬШJЪЬШJЪЬ Ш KШЧKШKШЧЧЪЬ9Щ9ЪЮЬЭЬЭЬ ЭЬЭЬЭЬШJKЪЭЬCЭЬЭЬЭЬЭЬЭЬЭЬЭЬШnKШKШЧЪЮЬЭЬЭЬ ЭЬЭЬЭЬ ШTЪЭЬЭЬШ%KЪЬЭЬDШ`KЪЭЬ Ш&KШЧKЪЭЬЭЬШKШKШЧЪЮЬЭЬЭЬ ЭЬЭЬЭЬ ШNЪЭЬЭЬШ%KЪЬЭЬDШ`KЪЭЬШ KШЧKЪЭЬЭЬШKШЧЧЪЬЩЪЮЬЭЬЭЬШJЪЬ$ЭЬШCJЪЬЭЬШ)JЪЬЭЬШ3JЪЬЭЬ/ШFJЪЬ ЭЬШJЪЬЭЬЭЬ5ШAJЪЬШJЪЬШJЪЭЬЭЬЭЬЭЬШ.JЪЬШЪЭЬЭЬЭЬЭШ JЪЬEШEЪЭЬЭЬШJЪЬШJЪЭЬЭЬЯШEJШЧJЪЭЬШЧJЪЬШJЪЬШJЪЭЬЭЬЭЬЭЬШ.JЪЬШJШJШЧЪЮЬЭЬЭЬШ"JЪЬЭЬЭЬШ"JШJШЧЪЮЬЭЬЭЬ ШJЪЬ)ЭЬШKJЪЬЭЬ4ШKJЪЬЭЬ Ш$JЪЬШЪЭЬЭЬЭЬЭШ*JЪЬGШGKЪЭЬЭЬШ@JЪЭЬШЧJЪЬШKШJШЧЪЮЬЭЬШJЪЬШJЪЬШЧЧЪЮ Щ ЪЮЬЭЬЭЬШJЪЬЭЬ"ШCJЪЬЭЬШ0JЪЬЭЬШ2ЪЭЬЭЬЭЬЭШ(JЪ ЭЬЭЬJЭЬЭЬЭЬШcJЪЭЬШЧJЪЭЬЭЬШ JШJШЧЪЮЬЭЬЭЬШ%JЪЬ)ЭЬШLJЪЬЭЬ Ш.JЪЬЭЬ4ШKJЪЮЬЭЬШ$JЪЮЬЭЬШ3JЪ ЭЬЭЬЭЬЭЬЭЬШ?ЪЭЬЭЬЭЬШKЪЬ@Ш@KЪЬШKЪЬШЧKШKШЧЪЮЬЭЬЭЬШJЪЬ)ЭЬШLJЪЬЭЬ Ш.JЪЬЭЬ4ШKJЪЮЬЭЬШ$JЪЮЬЭЬШ3KЪЬШЪЭЬЭЬЭЬШKЪЬ6Ш6KЪЬШKЪЬШЧKШKШЧKШJШJШЧJЪЭЬШJШЧЕЧ@,"