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

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

ExtensionFieldsImpl: CEDAR PROGRAM
IMPORTS Rope, IO, AlgebraClasses, RatIntervals, DistribPolys, Polynomials , MathConstructors
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];
primitiveElement: AC.Object _ data.primitiveElement;
primitiveElementData: AN.AlgebraicNumberData _ NARROW[primitiveElement.data];
fieldOfAlgebraicNumbersData: AN.FieldOfAlgebraicNumbersData _ NARROW[primitiveElement.structure.instanceData];
minPolyRing: AC.Structure _  fieldOfAlgebraicNumbersData.minPolyRing;
    IF NOT fieldOfAlgebraicNumbersData.real THEN
    RETURN[Rope.Cat[
    "Extension of ",
    data.groundField.class.printName[data.groundField],
    " by root of ",
    minPolyRing.class.toRope[primitiveElementData.minimalPolynomial]
    ] ]
ELSE {
out: Rope.ROPE _ Rope.Cat[
"Extension of ",
data.groundField.class.printName[data.groundField],
" by the unique root of ",
minPolyRing.class.toRope[primitiveElementData.minimalPolynomial]
];
out _ Rope.Cat[out, " in ", RI.RatIntervals.class.toRope[primitiveElementData.isolatingInterval] ];
RETURN[out];
};
};
ClassShortPrintName: AC.PrintNameProc = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
primitiveElement: AC.Object _ data.primitiveElement;
RETURN[Rope.Concat[
data.groundField.class.shortPrintName[data.groundField],
primitiveElement.structure.class.toRope[primitiveElement]
] ];
};
ClassCharacteristic: AC.StructureRankOp = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
RETURN[ primitiveElementData.minimalPolynomial.structure.class.characteristic[primitiveElementData.minimalPolynomial.structure] ]
}; 
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] ];
        };
ClassToExpr: AC.ToExprOp = {
data: ExtensionFieldData _ NARROW[in.structure.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
dummyObject: AC.Object _ NEW[AC.ObjectRec _ [structure: minPolyRing, data: in.data]];
out _  MathConstructors.MakeVector[1, LIST[POL.MakePolyExpr[dummyObject]], FALSE];
}; 
ClassZero: AC.NullaryOp = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
RETURN[ primitiveElementData.minimalPolynomial.structure.class.zero[primitiveElementData.minimalPolynomial.structure] ]
}; 
ClassOne: AC.NullaryOp = {
data: ExtensionFieldData _ NARROW[structure.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
RETURN[ primitiveElementData.minimalPolynomial.structure.class.one[primitiveElementData.minimalPolynomial.structure] ]
};


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

    isElementOf: ClassIsElementOf,

legalFirstChar: ClassLegalFirstChar,
read: ClassRead,
fromRope: ClassFromRope,
toRope: ToRope,
write: Write,
toExpr: ClassToExpr,
toIndexRope: ToIndexRope,  

    add: Add,
    negate: Negate,
    subtract: Subtract,
    zero: ClassZero,

    multiply: Multiply,
    <<invert: Invert,>>
    <<divide: Divide,>>
    one: ClassOne,

    scalarMultiply: ScalarMultiply,

    equal: Equal,

    ordered: FALSE,

propList: NIL
    ] ];


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

    isElementOf: ClassIsElementOf,

legalFirstChar: ClassLegalFirstChar,
read: ClassRead,
fromRope: ClassFromRope,
toRope: ToRope,
write: Write,
toExpr: ClassToExpr,
toIndexRope: ToIndexRope,  

    add: Add,
    negate: Negate,
    subtract: Subtract,
    zero: ClassZero,

    multiply: Multiply,
    <<invert: Invert,>>
    <<divide: Divide,>>
    one: ClassOne,

    scalarMultiply: ScalarMultiply,

    equal: Equal,

    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] ~ {
    primitiveElementData: AN.AlgebraicNumberData _ NARROW[primitiveElement.data];

    data: POL.PolynomialRingData _ NARROW[primitiveElementData.minimalPolynomial.structure.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 groundField.class.realField THEN -- equivalent to: IF NOT primitiveElement.real
        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;
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure; 
minPolyRingData: POL.PolynomialRingData _ NARROW[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, minPolyRing];
IF NOT reduced THEN out _ POL.Remainder[out, primitiveElementData.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];
};

ToRope: PUBLIC AC.ToRopeOp ~ {
extensionField: AC.Structure _ in.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
in.structure _ minPolyRing;  -- make it look like a polynomial
out _ Rope.Cat["[ ", minPolyRing.class.toRope[in], " ]" ];
in.structure _ extensionField;  -- restore
};

ToIndexRope: PUBLIC AC.ToRopeOp ~ {
out _ "ExtensionFieldElement";
};

Write: PUBLIC AC.WriteOp ~ {
stream.PutRope[ ToRope[in] ]
};
<<Arithmetic>>

Add: PUBLIC AC.BinaryOp ~ {
extensionField: AC.Structure _ firstArg.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
firstArg.structure _ minPolyRing;  -- make it look like a polynomial
secondArg.structure _ minPolyRing;  -- make it look like a polynomial
result _ POL.Add[firstArg, secondArg];
result.structure _ extensionField; -- lift
firstArg.structure _ extensionField;  -- restore
secondArg.structure _ extensionField;  -- restore
RETURN[ result ];
};

Negate: PUBLIC AC.UnaryOp ~ {
extensionField: AC.Structure _ arg.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
arg.structure _ minPolyRing;  -- make it look like a polynomial
result _ POL.Negate[arg];
result.structure _ extensionField; -- lift
arg.structure _ extensionField;  -- restore
RETURN[ result ];
};

Subtract: PUBLIC AC.BinaryOp ~ {
extensionField: AC.Structure _ firstArg.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
firstArg.structure _ minPolyRing;  -- make it look like a polynomial
secondArg.structure _ minPolyRing;  -- make it look like a polynomial
result _ POL.Subtract[firstArg, secondArg];
result.structure _ extensionField; -- lift
firstArg.structure _ extensionField;  -- restore
secondArg.structure _ extensionField;  -- restore
RETURN[ result ];
};

Multiply: PUBLIC AC.BinaryOp ~ {
extensionField: AC.Structure _ firstArg.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
firstArg.structure _ minPolyRing;  -- make it look like a polynomial
secondArg.structure _ minPolyRing;  -- make it look like a polynomial
result _ POL.Remainder[POL.Multiply[firstArg, secondArg], primitiveElementData.minimalPolynomial];
result.structure _ extensionField; -- lift
firstArg.structure _ extensionField;  -- restore
secondArg.structure _ extensionField;  -- restore
RETURN[ result ];
};

<<Invert: PUBLIC AC.UnaryOp ~ {>>
<<>>
<<Divide: PUBLIC AC.BinaryOp ~ {>>
<<>>
ScalarMultiply: PUBLIC AC.BinaryOp ~ {
extensionField: AC.Structure _ secondArg.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
scalarPoly: POL.Polynomial _ POL.Monom[firstArg, NEW[CARDINAL _ 0], minPolyRing]; -- will check that scalar belongs to minPolyRing
secondArg.structure _ minPolyRing;  -- make it look like a polynomial
result _ POL.Multiply[scalarPoly, secondArg];
result.structure _ extensionField; -- lift
secondArg.structure _ extensionField;  -- restore
RETURN[ result ];
};
<<Miscellaneous>>
Equal: PUBLIC AC.EqualityOp ~ {
extensionField: AC.Structure _ firstArg.structure; -- save
data: ExtensionFieldData _ NARROW[extensionField.instanceData];
primitiveElementData: AN.AlgebraicNumberData _ NARROW[data.primitiveElement.data];
minPolyRing: AC.Structure _ primitiveElementData.minimalPolynomial.structure;
val: BOOL;
firstArg.structure _ minPolyRing;  -- make it look like a polynomial
secondArg.structure _ minPolyRing;  -- make it look like a polynomial
val _ POL.Equal[firstArg, secondArg];
firstArg.structure _ extensionField;  -- restore
secondArg.structure _ extensionField;  -- restore
RETURN[val];
};

END.