PointsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
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;
Errors
SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE;
BadElementStructure: PUBLIC ERROR [coordinateStructure: AC.Structure] = CODE;
TypeError: PUBLIC ERROR [message: ATOM ← $Unspecified] = CODE;
Class for Point Structures
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 = {
Assumes that if item is a point, then it really belongs to the domain pointed to by its structure field.
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];
};
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] ]
};
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]];
};
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] ]
};
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,
characteristic: ClassCharacteristic,
isElementOf: ClassIsElementOf,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
write: Write,
toExpr: ClassToExpr,
add: ClassAdd,
negate: ClassNegate,
subtract: ClassSubtract,
zero: ClassZero,
multiply: ClassMultiply,
commutative: FALSE,
one: ClassOne,
equal: Equal,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
propList: LIST[pointProp]
] ];
Point Structure Constructor
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
] ] ];
};
Extract Point Operations from Class Record Property Lists
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;
};
Conversion and IO
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] ]
};
Operations
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.