<> <> DIRECTORY Rope, Basics, Ascii, IO, AlgebraClasses, RatIntervals, Variables, DistribPolys, Polynomials, AlgebraicNumbers, ExtensionFields; ExtensionFieldsImpl: CEDAR PROGRAM IMPORTS Rope, IO, RatIntervals, DistribPolys, Polynomials EXPORTS ExtensionFields = BEGIN OPEN AC: AlgebraClasses, RI: RatIntervals, VARS: Variables, DP: DistribPolys, POL: Polynomials, AN: AlgebraicNumbers, ExtensionFields; <> SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE; BadGroundField: PUBLIC ERROR [elementStructure: AC.Structure] = CODE; <> ClassPrintName: AC.PrintNameProc = { data: ExtensionFieldData _ NARROW[structure.instanceData]; minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing; IF NOT data.primitiveElement.real THEN RETURN[Rope.Cat[ "Extension of ", data.groundField.class.printName[data.groundField], " by root of ", minPolyRing.class.toRope[data.primitiveElement.minimalPolynomial, minPolyRing] ] ] ELSE { out: Rope.ROPE _ Rope.Cat[ "Extension of ", data.groundField.class.printName[data.groundField], " by the unique root of ", minPolyRing.class.toRope[data.primitiveElement.minimalPolynomial, minPolyRing] ]; out _ Rope.Cat[out, " in ", RI.RatIntervalToRope[data.primitiveElement.isolatingInterval] ]; RETURN[out]; }; }; ClassLegalFirstChar: AC.LegalFirstCharOp = { SELECT char FROM '[, '( => RETURN[TRUE]; ENDCASE; RETURN[FALSE]; }; ClassRead: AC.ReadOp = { data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ReadExtensionFieldElement[in, data.primitiveElement, FALSE] ]; }; ClassFromRope: AC.FromRopeOp = { stream: IO.STREAM _ IO.RIS[in]; RETURN[ ClassRead[stream, structure] ]; }; ClassToRope: AC.ToRopeOp = { fieldElement: ExtensionFieldElement _ NARROW[in]; data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ ExtensionFieldElementToRope[fieldElement, data.primitiveElement] ] }; ClassWrite: AC.WriteOp = { IO.PutRope[stream, ClassToRope[in, structure] ] }; ClassZero: AC.NullaryOp = { data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ data.primitiveElement.minPolyRing.class.zero[data.primitiveElement.minPolyRing] ] }; ClassOne: AC.NullaryOp = { data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ data.primitiveElement.minPolyRing.class.one[data.primitiveElement.minPolyRing] ] }; ClassCharacteristic: AC.StructureRankOp = { data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ data.primitiveElement.minPolyRing.class.characteristic[data.primitiveElement.minPolyRing] ] }; ClassAdd: AC.BinaryOp = { firstFieldElement: ExtensionFieldElement _ NARROW[firstArg]; secondFieldElement: ExtensionFieldElement _ NARROW[secondArg]; data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ Add[firstFieldElement, secondFieldElement, data.groundField] ] }; ClassNegate: AC.UnaryOp = { fieldElement: ExtensionFieldElement _ NARROW[arg]; data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ Negate[fieldElement, data.groundField] ] }; ClassSubtract: AC.BinaryOp = { firstFieldElement: ExtensionFieldElement _ NARROW[firstArg]; secondFieldElement: ExtensionFieldElement _ NARROW[secondArg]; data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ Subtract[firstFieldElement, secondFieldElement, data.groundField] ] }; ClassMultiply: AC.BinaryOp = { firstFieldElement: ExtensionFieldElement _ NARROW[firstArg]; secondFieldElement: ExtensionFieldElement _ NARROW[secondArg]; RETURN[ Multiply[firstFieldElement, secondFieldElement, structure] ] }; <> <> <> <> <<};>> <<>> <> <> <> <> <> <<}; >> <<>> ClassScalarMultiply: AC.BinaryOp = { scalar: REF _ firstArg; inExtensionField: ExtensionFieldElement _ NARROW[secondArg]; RETURN[ ScalarMultiply[scalar, inExtensionField, structure] ] }; <<>> ClassEqual: AC.EqualityOp = { firstFieldElement: ExtensionFieldElement _ NARROW[firstArg]; secondFieldElement: ExtensionFieldElement _ NARROW[secondArg]; data: ExtensionFieldData _ NARROW[structure.instanceData]; RETURN[ Equal[firstFieldElement, secondFieldElement, data.groundField] ] }; generalExtensionFieldClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [ flavor: divisionAlgebra, printName: ClassPrintName, legalFirstChar: ClassLegalFirstChar, read: ClassRead, fromRope: ClassFromRope, toRope: ClassToRope, write: ClassWrite, add: ClassAdd, negate: ClassNegate, subtract: ClassSubtract, zero: ClassZero, multiply: ClassMultiply, <> <> one: ClassOne, scalarMultiply: ClassScalarMultiply, equal: ClassEqual, characteristic: ClassCharacteristic, propList: NIL ] ]; realExtensionFieldClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [ flavor: divisionAlgebra, printName: ClassPrintName, legalFirstChar: ClassLegalFirstChar, read: ClassRead, fromRope: ClassFromRope, toRope: ClassToRope, write: ClassWrite, add: ClassAdd, negate: ClassNegate, subtract: ClassSubtract, zero: ClassZero, multiply: ClassMultiply, <> <> one: ClassOne, scalarMultiply: ClassScalarMultiply, equal: ClassEqual, characteristic: ClassCharacteristic, propList: NIL ] ]; <> MakeExtensionField: PUBLIC PROC [primitiveElement: AN.AlgebraicNumber] RETURNS [extensionField: AC.Structure] ~ { data: POL.PolynomialRingData _ NARROW[primitiveElement.minPolyRing.instanceData]; groundField: AC.Structure _ data.coeffRing; extensionFieldData: ExtensionFieldData _ NEW[ExtensionFieldDataRec _ [ groundField: groundField, primitiveElement: primitiveElement ] ]; IF groundField.class.flavor#field AND groundField.class.flavor#divisionAlgebra THEN ERROR BadGroundField[groundField]; IF NOT groundField.class.realField THEN RETURN[ NEW[AC.StructureRec _ [ class: generalExtensionFieldClass, instanceData: extensionFieldData ] ] ] ELSE RETURN[ NEW[AC.StructureRec _ [ class: realExtensionFieldClass, instanceData: extensionFieldData ] ] ] }; <> IsGeneralExtensionField: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ { IF structure.class.flavor#field AND structure.class.flavor#divisionAlgebra THEN RETURN[FALSE]; IF ISTYPE[structure.instanceData, ExtensionFieldData] AND NOT structure.class.realField THEN RETURN[TRUE] ELSE RETURN[FALSE]; }; <<>> IsRealField: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ { IF structure.class.flavor#field AND structure.class.flavor#divisionAlgebra THEN RETURN[FALSE]; IF structure.class.realField THEN RETURN[TRUE] ELSE RETURN[FALSE]; }; <<>> IsRealExtensionField: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ { IF structure.class.flavor#field AND structure.class.flavor#divisionAlgebra THEN RETURN[FALSE]; IF ISTYPE[structure.instanceData, ExtensionFieldData] AND structure.class.realField THEN RETURN[TRUE] ELSE RETURN[FALSE]; }; <> ReadExtensionFieldElement: PUBLIC PROC [in: IO.STREAM, algebraicNumber: AN.AlgebraicNumber, reduced: BOOL _ FALSE] RETURNS [out: ExtensionFieldElement] ~ { char: CHAR; dElt: DP.DPolynomial; data: POL.PolynomialRingData _ NARROW[algebraicNumber.minPolyRing.instanceData]; fieldElementVariable: VARS.VariableSeq _ data.variables; []_ in.SkipWhitespace[]; char _ in.GetChar[]; IF char # '( AND char#'[ THEN ERROR; -- accept either curved (SAC-2) or square brackets [dElt, char] _ DP.ReadDPoly[in, fieldElementVariable, data.coeffRing, DP.RightBracketProc]; -- terminated by a right bracket, not a dollar sign out _ POL.PolyFromDPoly[ dElt, fieldElementVariable]; IF NOT reduced THEN out _ POL.Remainder[out, algebraicNumber.minimalPolynomial, algebraicNumber.minPolyRing]; }; ExtensionFieldElementFromRope: PUBLIC PROC [in: Rope.ROPE, algebraicNumber: AN.AlgebraicNumber, reduced: BOOL _ FALSE] RETURNS [out: ExtensionFieldElement] ~ { out _ ReadExtensionFieldElement[IO.RIS[in], algebraicNumber, reduced]; }; ExtensionFieldElementToRope: PUBLIC PROC [in: ExtensionFieldElement, algebraicNumber: AN.AlgebraicNumber] RETURNS [out: Rope.ROPE] ~ { out _ Rope.Concat["[ ", algebraicNumber.minPolyRing.class.toRope[in, algebraicNumber.minPolyRing ] ]; out _ Rope.Replace[out, Rope.Length[out]-2, 2, "]" ]; }; WriteExtensionFieldElement: PUBLIC PROC [in: ExtensionFieldElement, algebraicNumber: AN.AlgebraicNumber, out: IO.STREAM] ~ { out.PutRope[ ExtensionFieldElementToRope[in, algebraicNumber] ] }; <> Add: PUBLIC PROC [in1, in2: ExtensionFieldElement, groundField: AC.Structure] RETURNS [out: ExtensionFieldElement] ~ { RETURN[POL.Add[in1, in2, groundField] ]; }; Negate: PUBLIC PROC [in: ExtensionFieldElement, groundField: AC.Structure] RETURNS [out: ExtensionFieldElement] ~ { RETURN[POL.Negate[in, groundField] ]; }; Subtract: PUBLIC PROC [in1, in2: ExtensionFieldElement, groundField: AC.Structure] RETURNS [ExtensionFieldElement] ~ { RETURN[POL.Subtract[in1, in2, groundField] ]; }; Multiply: PUBLIC PROC [in1, in2: ExtensionFieldElement, extensionField: AC.Structure] RETURNS [out: ExtensionFieldElement] ~ { data: ExtensionFieldData _ NARROW[extensionField.instanceData]; temp: POL.Polynomial _ POL.Multiply[in1, in2, data.groundField]; RETURN[POL.Remainder[temp, data.primitiveElement.minimalPolynomial, data.primitiveElement.minPolyRing ] ]; }; <> <<>> <> <<>> ScalarMultiply: PUBLIC PROC [scalar: REF, in: ExtensionFieldElement, extensionField: AC.Structure] RETURNS [out: ExtensionFieldElement] ~ { scalarPoly: ExtensionFieldElement _ POL.UnivariateMonomialConstructor[scalar, 0]; RETURN[Multiply[scalarPoly, in, extensionField] ]; }; <> Equal: PUBLIC PROC [in1, in2: ExtensionFieldElement, groundField: AC.Structure] RETURNS [BOOL] ~ { RETURN[POL.Equal[in1, in2, groundField] ]; }; END.