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;
Classes 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]
] ];
};
ClassShortPrintName: AC.PrintNameProc = {
data: PointStructureData ← NARROW[structure.instanceData];
RETURN[Rope.Cat[
"P",
Convert.RopeFromCard[data.dimension],
"(",
data.coordinateStructure.class.shortPrintName[data.coordinateStructure],
")"
] ];
};
ClassReportOps: AC.ReportOpsProc = {
class: AC.StructureClass ← structure.class;
opNames ← CONS["MainCoordinate", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← MainCood ], refOps];
opNames ← CONS["RemoveMainCoordinate", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← RemoveMainCood ], refOps];
IF class.equal # NIL THEN { opNames ← CONS["Equal", opNames];
refOps ← CONS[NEW[AC.EqualityOp ← Equal], refOps] };
IF class.multiply # NIL THEN { opNames ← CONS["Multiply", opNames];
refOps ← CONS[NEW[AC.BinaryOp ← Multiply], refOps] };
IF class.subtract # NIL THEN { opNames ← CONS["Subtract", opNames];
refOps ← CONS[NEW[AC.BinaryOp ← Subtract], refOps] };
IF class.negate # NIL THEN { opNames ← CONS["Negate", opNames];
refOps ← CONS[NEW[AC.UnaryOp ← Negate], refOps] };
IF class.add # NIL THEN { opNames ← CONS["Add", opNames];
refOps ← CONS[NEW[AC.BinaryOp ← Add], refOps] };
opNames ← CONS["FromLinearRope", opNames];
refOps ← CONS[NEW[AC.FromRopeOp ← FromRope], refOps];
};
ClassCharacteristic: AC.StructureRankOp = {
data: PointStructureData ← NARROW[structure.instanceData];
RETURN[ data.coordinateStructure.class.characteristic[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];
};
ClassToExpr: AC.ToExprOp = {
data: PointStructureData;
inData: PointData;
outRow: LIST OF MathExpr.EXPR ← NIL;
IF in=NIL OR in.data=NIL THEN RETURN[MathConstructors.MakeVariable["NilPoint"]];
inData ← NARROW[in.data];
data ← NARROW[in.structure.instanceData];
FOR j:NAT DECREASING IN [1..data.dimension] DO
outRow ← CONS[data.coordinateStructure.class.toExpr[inData[j] ], outRow];
ENDLOOP;
out ← MathConstructors.MakeVector[data.dimension, outRow, TRUE];
};
ClassZero: AC.NullaryOp = {
structureData: PointStructureData ← NARROW[structure.instanceData];
coordinateStructure: AC.Structure ← structureData.coordinateStructure;
RETURN[ ImbedSc[coordinateStructure.class.zero[coordinateStructure], structure] ]
};
ClassOne: AC.NullaryOp = {
structureData: PointStructureData ← NARROW[structure.instanceData];
coordinateStructure: AC.Structure ← structureData.coordinateStructure;
RETURN[ ImbedSc[coordinateStructure.class.one[coordinateStructure], structure] ]
};
pointStructureOps: PointOps ← NEW[PointOpsRec ← [
removeMainCoordinate: RemoveMainCood,
mainCoordinate: MainCood,
imbedScalar: ImbedSc,
makePoint: MakePt
] ];
pointProp: Atom.DottedPair ← NEW[Atom.DottedPairNode← [$PointStructure, pointStructureOps]];
pointsOverSetClass: PUBLIC AC.StructureClass ← NEW[AC.StructureClassRec ← [
category: set,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
structureEqual: AC.defaultStructureEqualityTest,
isElementOf: ClassIsElementOf,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope, toIndexRope: ToIndexRope,
write: Write,
toExpr: ClassToExpr,
equal: Equal,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
propList: LIST[pointProp]
] ];
pointsOverAbelianGroupClass: PUBLIC AC.StructureClass ← NEW[AC.StructureClassRec ← [
category: group,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
structureEqual: AC.defaultStructureEqualityTest,
isElementOf: ClassIsElementOf,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
toIndexRope: ToIndexRope,
write: Write,
toExpr: ClassToExpr,
add: Add,
negate: Negate,
subtract: Subtract,
zero: ClassZero,
multiply: ClassMultiply,
commutative: FALSE,
one: ClassOne,
equal: Equal,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
propList: LIST[pointProp]
] ];
pointsOverRingClass: PUBLIC AC.StructureClass ← NEW[AC.StructureClassRec ← [
category: ring,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
structureEqual: AC.defaultStructureEqualityTest,
characteristic: ClassCharacteristic,
isElementOf: ClassIsElementOf,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
toIndexRope: ToIndexRope,
write: Write,
toExpr: ClassToExpr,
add: Add,
negate: Negate,
subtract: Subtract,
zero: ClassZero,
multiply: Multiply,
commutative: FALSE, -- commutative: FALSE may be bogus
one: ClassOne,
equal: Equal,
integralDomain: FALSE,
gcdDomain: FALSE,
euclideanDomain: FALSE,
propList: LIST[pointProp]
] ];
Point Structure Constructor
MakePointStructure: PUBLIC AC.PointStructureConstructor ~ {
pointStructureData: PointStructureData ← NEW[PointStructureDataRec ← [
coordinateStructure: coordinateStructure,
dimension: dimension
] ];
SELECT coordinateStructure.class.category FROM
set, lattice =>
RETURN[ NEW[AC.StructureRec ← [
class: pointsOverSetClass,
instanceData: pointStructureData
] ] ];
group, module, vectorSpace =>
RETURN[ NEW[AC.StructureRec ← [
class: pointsOverAbelianGroupClass,
instanceData: pointStructureData
] ] ];
ring, field, algebra, divisionAlgebra =>
RETURN[ NEW[AC.StructureRec ← [
class: pointsOverRingClass,
instanceData: pointStructureData
] ] ];
ENDCASE => ERROR BadElementStructure[coordinateStructure];
};
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;
};
ImbedScalar: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.UnaryImbedOp] ~ {
IF IsPointStructure[structure] THEN {
pointOps: PointOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $PointStructure] ];
RETURN[pointOps.imbedScalar];
}
ELSE ERROR;
};
MakePoint: PUBLIC PROC [structure: AC.Structure] RETURNS [AC.ListImbedOp] ~ {
IF IsPointStructure[structure] THEN {
pointOps: PointOps ← NARROW[ Atom.GetPropFromList[structure.class.propList, $PointStructure] ];
RETURN[pointOps.makePoint];
}
ELSE ERROR;
};
Point Constructors
ImbedScalar: PUBLIC AC.UnaryImbedOp ~ {
structureData: PointStructureData ← NARROW[structure.instanceData];
coordinateStructure: AC.Structure ← structureData.coordinateStructure;
outData: PointData ← NEW[PointDataRec[structureData.dimension] ];
IF NOT in.structure.class.structureEqual[in.structure, coordinateStructure] THEN ERROR TypeError[];
FOR i: NAT IN [1..structureData.dimension] DO outData[i] ← in; ENDLOOP;
out ← NEW[AC.ObjectRec ← [structure: structure, data: outData] ];
};
MakePoint: PUBLIC AC.ListImbedOp ~ {
structureData: PointStructureData ← NARROW[structure.instanceData];
coordinateStructure: AC.Structure ← structureData.coordinateStructure;
length: NAT ← 0;
ptr: LIST OF AC.Object ← data;
outData: PointData;
WHILE ptr#NIL DO length ← length + 1; ptr ← ptr.rest ENDLOOP;
IF length # structureData.dimension THEN ERROR;
outData ← NEW[PointDataRec[length] ];
FOR i:NAT IN [1..length] DO
outData[i] ← data.first;
data ← data.rest;
ENDLOOP;
out ← NEW[AC.ObjectRec ← [structure: structure, data: outData] ];
};
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, " )" ];
};
ToIndexRope: PUBLIC AC.ToRopeOp ~ {
out ← "Point";
};
Write: PUBLIC AC.WriteOp ~ {
stream.PutRope[ ToRope[in] ]
};
Point Structure Operations
IsPointStructure: PUBLIC AC.StructurePredicate ~ {
IF Atom.GetPropFromList[structure.class.propList, $PointStructure] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];
};
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;
PData: PointData ← NARROW[arg.data];
RETURN[ PData[dimension] ];
};
Comparison
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];
};
Arithmetic
Add: PUBLIC AC.BinaryOp ~ {
pointStructureData: PointStructureData ← NARROW[firstArg.structure.instanceData];
dimension: NAT ← pointStructureData.dimension;
coordinateStructure: AC.Structure ← pointStructureData.coordinateStructure;
firstData: PointData ← NARROW[firstArg.data];
secondData: PointData ← NARROW[secondArg.data];
resultData: PointData ← NEW[PointDataRec[dimension] ];
FOR i: NAT IN [1..dimension] DO
resultData[i] ← coordinateStructure.class.add[firstData[i], secondData[i] ];
ENDLOOP;
RETURN[ NEW[AC.ObjectRec ← [
structure: firstArg.structure,
data: resultData
] ] ];
};
Negate: PUBLIC AC.UnaryOp ~ {
pointStructureData: PointStructureData ← NARROW[arg.structure.instanceData];
dimension: NAT ← pointStructureData.dimension;
coordinateStructure: AC.Structure ← pointStructureData.coordinateStructure;
data: PointData ← NARROW[arg.data];
resultData: PointData ← NEW[PointDataRec[dimension] ];
FOR i: NAT IN [1..dimension] DO
resultData[i] ← coordinateStructure.class.negate[data[i] ];
ENDLOOP;
RETURN[ NEW[AC.ObjectRec ← [
structure: arg.structure,
data: resultData
] ] ];
};
Subtract: PUBLIC AC.BinaryOp ~ {
pointStructureData: PointStructureData ← NARROW[firstArg.structure.instanceData];
dimension: NAT ← pointStructureData.dimension;
coordinateStructure: AC.Structure ← pointStructureData.coordinateStructure;
firstData: PointData ← NARROW[firstArg.data];
secondData: PointData ← NARROW[secondArg.data];
resultData: PointData ← NEW[PointDataRec[dimension] ];
FOR i: NAT IN [1..dimension] DO
resultData[i] ← coordinateStructure.class.subtract[firstData[i], secondData[i] ];
ENDLOOP;
RETURN[ NEW[AC.ObjectRec ← [
structure: firstArg.structure,
data: resultData
] ] ];
};
Multiply: PUBLIC AC.BinaryOp ~ {
pointStructureData: PointStructureData ← NARROW[firstArg.structure.instanceData];
dimension: NAT ← pointStructureData.dimension;
coordinateStructure: AC.Structure ← pointStructureData.coordinateStructure;
firstData: PointData ← NARROW[firstArg.data];
secondData: PointData ← NARROW[secondArg.data];
resultData: PointData ← NEW[PointDataRec[dimension] ];
FOR i: NAT IN [1..dimension] DO
resultData[i] ← coordinateStructure.class.multiply[firstData[i], secondData[i] ];
ENDLOOP;
RETURN[ NEW[AC.ObjectRec ← [
structure: firstArg.structure,
data: resultData
] ] ];
};
Start Code
pointsOverSetClass ← AC.MakeClass["PointsOverSetClass", NIL, NIL];
pointsOverAbelianGroupClass ← AC.MakeClass["PointsOverAbelianGroupClass", NIL, NIL];
pointsOverRingClass ← AC.MakeClass["PointsOverRingClass", NIL, NIL];
END.