
<<ExtensionFieldsImpl.mesa>>
<<Last Edited by: Arnon, June 10, 1985 4:19:22 pm PDT>>

DIRECTORY
Rope,
Basics,
Ascii,
IO,
AlgebraClasses,
RatIntervals,
Variables,
DistribPolys,
Polynomials,
AlgebraicNumbers,
ExtensionFields;

ExtensionFieldsImpl: CEDAR PROGRAM
IMPORTS Rope, IO, AlgebraClasses, RatIntervals, DistribPolys, Polynomials 
EXPORTS ExtensionFields =

BEGIN OPEN AC: AlgebraClasses, RI: RatIntervals, VARS: Variables, DP: DistribPolys, POL: Polynomials, AN: AlgebraicNumbers, 
ExtensionFields;
<<Errors>>
SyntaxError: PUBLIC ERROR [reason: ATOM] = CODE;
BadGroundField: PUBLIC ERROR [elementStructure: AC.Structure] = CODE;
<<Classes for ExtensionFields>>
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]
    ] ]
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]
];
out _ Rope.Cat[out, " in ", RI.RatIntervalToRope[data.primitiveElement.isolatingInterval] ];
RETURN[out];
};
};
ClassCharacteristic: AC.StructureRankOp = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
RETURN[ data.primitiveElement.minPolyRing.class.characteristic[data.primitiveElement.minPolyRing] ]
}; 
ClassIsElementOf: AC.ElementOfProc = {
<<Assumes that if item is a ExtensionFieldElement, then it really belongs to the domain pointed to by its structure field.>>
fieldElement: ExtensionFieldElement;
IF NOT ISTYPE[item, ExtensionFieldElement] THEN RETURN[FALSE];
fieldElement _ NARROW[item];
IF NOT structure.class.structureEqual[structure, fieldElement.structure] THEN RETURN[FALSE];
RETURN[ TRUE ]
}; 
ClassLegalFirstChar: AC.LegalFirstCharOp = {
    SELECT char FROM
        '[, '( => RETURN[TRUE];
        ENDCASE;
    RETURN[FALSE];
};
ClassRead: AC.ReadOp = {
RETURN[ReadExtensionFieldElement[in, structure, FALSE] ];
};
    ClassFromRope: AC.FromRopeOp = {
        stream: IO.STREAM _ IO.RIS[in];
        RETURN[ ClassRead[stream, structure] ];
        };
ClassToRope: AC.ToRopeOp = {
fieldElement: ExtensionFieldElement _ NARROW[in];
RETURN[ ExtensionFieldElementToRope[fieldElement] ]
};
ClassWrite: AC.WriteOp = {
IO.PutRope[stream, ClassToRope[in] ]
}; 
ClassAdd: AC.BinaryOp = {
firstFieldElement: ExtensionFieldElement _ NARROW[firstArg];
secondFieldElement: ExtensionFieldElement _ NARROW[secondArg];
RETURN[ Add[firstFieldElement, secondFieldElement] ]
}; 
ClassNegate: AC.UnaryOp = {
fieldElement: ExtensionFieldElement _ NARROW[arg];
RETURN[ Negate[fieldElement] ]
}; 
ClassSubtract: AC.BinaryOp = {
firstFieldElement: ExtensionFieldElement _ NARROW[firstArg];
secondFieldElement: ExtensionFieldElement _ NARROW[secondArg];
RETURN[ Subtract[firstFieldElement, secondFieldElement] ]
}; 
ClassZero: AC.NullaryOp = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
RETURN[ data.primitiveElement.minPolyRing.class.zero[data.primitiveElement.minPolyRing] ]
}; 
ClassMultiply: AC.BinaryOp = {
firstFieldElement: ExtensionFieldElement _ NARROW[firstArg];
secondFieldElement: ExtensionFieldElement _ NARROW[secondArg];
RETURN[ Multiply[firstFieldElement, secondFieldElement] ]
}; 
ClassOne: AC.NullaryOp = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
RETURN[ data.primitiveElement.minPolyRing.class.one[data.primitiveElement.minPolyRing] ]
};
<<ClassInvert: AC.UnaryOp = {>>
<<fieldElement: ExtensionFieldElement _ NARROW[arg];>>
<<data: ExtensionFieldData _ NARROW[structure.instanceData];>>
<<RETURN[ Invert[fieldElement, data.groundField] ]>>
<<};>>
<<>>
<<ClassDivide: AC.BinaryOp = {>>
<<firstFieldElement: ExtensionFieldElement _ NARROW[firstArg];>>
<<secondFieldElement: ExtensionFieldElement _ NARROW[secondArg];>>
<<data: ExtensionFieldData _ NARROW[structure.instanceData];>>
<<RETURN[ Divide[firstFieldElement, secondFieldElement, data.groundField] ]>>
<<}; >>
    <<>>
ClassScalarMultiply: AC.BinaryOp = {
scalar: AC.Object _ firstArg;
inExtensionField: ExtensionFieldElement _ NARROW[secondArg];
RETURN[ ScalarMultiply[scalar, inExtensionField] ]
}; 
    <<>>
ClassEqual: AC.EqualityOp = {
firstFieldElement: ExtensionFieldElement _ NARROW[firstArg];
secondFieldElement: ExtensionFieldElement _ NARROW[secondArg];
RETURN[ Equal[firstFieldElement, secondFieldElement] ]
}; 


generalExtensionFieldClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [
category: divisionAlgebra,
printName: ClassPrintName,
    structureEqual: AC.defaultStructureEqualityTest,
characteristic: ClassCharacteristic,

    isElementOf: ClassIsElementOf,

legalFirstChar: ClassLegalFirstChar,
read: ClassRead,
fromRope: ClassFromRope,
toRope: ClassToRope,
write: ClassWrite,

    add: ClassAdd,
    negate: ClassNegate,
    subtract: ClassSubtract,
    zero: ClassZero,

    multiply: ClassMultiply,
    <<invert: ClassInvert,>>
    <<divide: ClassDivide,>>
    one: ClassOne,

    scalarMultiply: ClassScalarMultiply,

    equal: ClassEqual,

    ordered: FALSE,

propList: NIL
    ] ];


realExtensionFieldClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [
category: divisionAlgebra,
printName: ClassPrintName,
    structureEqual: AC.defaultStructureEqualityTest,
characteristic: ClassCharacteristic,

    isElementOf: ClassIsElementOf,

legalFirstChar: ClassLegalFirstChar,
read: ClassRead,
fromRope: ClassFromRope,
toRope: ClassToRope,
write: ClassWrite,

    add: ClassAdd,
    negate: ClassNegate,
    subtract: ClassSubtract,
    zero: ClassZero,

    multiply: ClassMultiply,
    <<invert: ClassInvert,>>
    <<divide: ClassDivide,>>
    one: ClassOne,

    scalarMultiply: ClassScalarMultiply,

    equal: ClassEqual,

    ordered: FALSE, -- can't set to true until have sign, abs, compare procs

    completeField: FALSE, -- correct assuming we have a proper subfield of the reals
    realField: TRUE, -- correct assuming we are not adjoining a complex algebraic number 
    realClosedField: FALSE,
    algebraicallyClosedField: FALSE,

propList: NIL
    ] ];

<<ExtensionField Constructors>>

    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.category#field AND groundField.class.category#divisionAlgebra THEN ERROR BadGroundField[groundField]; 
        IF NOT primitiveElement.real THEN -- equivalent to: IF NOT groundField.class.realField
        RETURN[ NEW[AC.StructureRec _ [
        class: generalExtensionFieldClass,
        instanceData: extensionFieldData
            ] ] ]
        ELSE
        RETURN[ NEW[AC.StructureRec _ [
        class: realExtensionFieldClass,
        instanceData: extensionFieldData
            ] ] ]

        };
<<Check Properties>>
    IsGeneralExtensionField: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {
        IF structure.class.category#field AND structure.class.category#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.category#field AND structure.class.category#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.category#field AND structure.class.category#divisionAlgebra THEN RETURN[FALSE];
        IF ISTYPE[structure.instanceData, ExtensionFieldData] AND structure.class.realField THEN RETURN[TRUE] ELSE RETURN[FALSE];
        }; 
<<Conversion and IO>>
ReadExtensionFieldElement: PUBLIC PROC [in: IO.STREAM, extensionField: AC.Structure, reduced: BOOL _ FALSE] RETURNS [out: 
ExtensionFieldElement] ~ {
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
char: CHAR;
dElt: DP.DPolynomial;
algebraicNumber: AN.AlgebraicNumber _ data.primitiveElement;
minPolyRingData: POL.PolynomialRingData _ NARROW[algebraicNumber.minPolyRing.instanceData];
fieldElementVariable: VARS.VariableSeq _ minPolyRingData.variable;
[]_ 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, minPolyRingData.coeffRing, DP.RightBracketProc]; -- terminated by a right 
bracket
[] _ in.GetChar[];  -- remove right bracket
out _ POL.PolyFromDPoly[ dElt, algebraicNumber.minPolyRing];
IF NOT reduced THEN out _ POL.Remainder[out, algebraicNumber.minimalPolynomial];
out.structure _ extensionField;  -- "lift" it from a polynomial to an extFieldElt
};

ExtensionFieldElementFromRope: PUBLIC PROC [in: Rope.ROPE, extensionField: AC.Structure, reduced: BOOL _ FALSE] RETURNS [out: 
ExtensionFieldElement] ~ {
out _ ReadExtensionFieldElement[IO.RIS[in], extensionField, reduced];
};

ExtensionFieldElementToRope: PUBLIC PROC [in: ExtensionFieldElement] RETURNS [out: Rope.ROPE] ~ {
extensionField: AC.Structure _ in.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
in.structure _ minPolyRing;  -- make it look like a polynomial
out _ Rope.Cat["[ ", minPolyRing.class.toRope[in], " ]" ];
in.structure _ extensionField;  -- restore
};

WriteExtensionFieldElement: PUBLIC PROC [in: ExtensionFieldElement, out: IO.STREAM] ~ {
out.PutRope[ ExtensionFieldElementToRope[in] ]
};
<<Arithmetic>>

Add: PUBLIC PROC [in1, in2: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {
extensionField: AC.Structure _ in1.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
in1.structure _ minPolyRing;  -- make it look like a polynomial
in2.structure _ minPolyRing;  -- make it look like a polynomial
out _ POL.Add[in1, in2];
out.structure _ extensionField; -- lift
in1.structure _ extensionField;  -- restore
in2.structure _ extensionField;  -- restore
RETURN[ out ];
};

Negate: PUBLIC PROC [in: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {
extensionField: AC.Structure _ in.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
in.structure _ minPolyRing;  -- make it look like a polynomial
out _ POL.Negate[in];
out.structure _ extensionField; -- lift
in.structure _ extensionField;  -- restore
RETURN[ out ];
};

Subtract: PUBLIC PROC [in1, in2: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {
extensionField: AC.Structure _ in1.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
in1.structure _ minPolyRing;  -- make it look like a polynomial
in2.structure _ minPolyRing;  -- make it look like a polynomial
out _ POL.Subtract[in1, in2];
out.structure _ extensionField; -- lift
in1.structure _ extensionField;  -- restore
in2.structure _ extensionField;  -- restore
RETURN[ out ];
};

Multiply: PUBLIC PROC [in1, in2: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {
extensionField: AC.Structure _ in1.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
in1.structure _ minPolyRing;  -- make it look like a polynomial
in2.structure _ minPolyRing;  -- make it look like a polynomial
out _ POL.Remainder[POL.Multiply[in1, in2], data.primitiveElement.minimalPolynomial];
out.structure _ extensionField; -- lift
in1.structure _ extensionField;  -- restore
in2.structure _ extensionField;  -- restore
RETURN[ out ];
};

<<Invert: PUBLIC PROC [in: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {>>
<<>>
<<Divide: PUBLIC PROC [in1, in2: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {>>
<<>>
ScalarMultiply: PUBLIC PROC [scalar: AC.Object, in: ExtensionFieldElement] RETURNS [out: ExtensionFieldElement] ~ {
extensionField: AC.Structure _ in.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
scalarPoly: POL.Polynomial _ POL.Monom[scalar, NEW[CARDINAL _ 0], minPolyRing]; -- will check that scalar belongs to minPolyRing
in.structure _ minPolyRing;  -- make it look like a polynomial
out _ POL.Multiply[scalarPoly, in];
out.structure _ extensionField; -- lift
in.structure _ extensionField;  -- restore
RETURN[ out ];
};
<<Miscellaneous>>
Equal: PUBLIC PROC [in1, in2: ExtensionFieldElement] RETURNS [BOOL] ~ {
extensionField: AC.Structure _ in1.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
minPolyRing: AC.Structure _ data.primitiveElement.minPolyRing;
val: BOOL;
in1.structure _ minPolyRing;  -- make it look like a polynomial
in2.structure _ minPolyRing;  -- make it look like a polynomial
val _ POL.Equal[in1, in2];
in1.structure _ extensionField;  -- restore
in2.structure _ extensionField;  -- restore
RETURN[val];
};

END.