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

DIRECTORY
Rope,
Basics,
Atom,
Ascii,
Convert,
IO,
AlgebraClasses,
Variables,
DistribPolys,
Polynomials;

PolynomialsImpl: CEDAR PROGRAM
IMPORTS Rope, Convert, IO, Atom, Variables, DistribPolys 
EXPORTS Polynomials =

BEGIN OPEN AC: AlgebraClasses, VARS: Variables, DP: DistribPolys, Polynomials;
<<Classes for Polynomial Rings>>
ClassPrintName: AC.PrintNameProc = {
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[Rope.Cat[
"Polynomials in ",
VARS.VariableSeqToRope[data.variables],
" over ",
data.coeffRing.class.printName[data.coeffRing]
] ];
};
ClassLegalFirstChar: AC.LegalFirstCharOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
    IF data.coeffRing.class.legalFirstChar[char, data.coeffRing] THEN RETURN[TRUE];
    RETURN[VARS.VariableFirstChar[char, data.variables] ];
        <<Legal first char of polynomial is either legal first char of coefficient, or first char of some variable.>>
};
ClassRead: AC.ReadOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ReadPoly[in, data.variables, data.coeffRing] ];
};
    ClassFromRope: AC.FromRopeOp = {
        stream: IO.STREAM _ IO.RIS[in];
        RETURN[ ClassRead[stream, structure] ];
        };
ClassToRope: AC.ToRopeOp = {
polynomial: Polynomial _ NARROW[in];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ PolyToRope[polynomial, data.variables, data.coeffRing] ] -- use defaults
};
ClassWrite: AC.WriteOp = {
polynomial: Polynomial _ NARROW[in];
IO.PutRope[stream, ClassToRope[polynomial, structure] ]
}; 
ClassZero: AC.NullaryOp = {
RETURN[ ZeroPoly ]
}; 
ClassOne: AC.NullaryOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
    one: Polynomial _ UnivariateMonomialConstructor[data.coeffRing.class.one[data.coeffRing], 0];
FOR i:NAT IN [2..data.variables.lengthPlus1) DO one _ MultivariateMonomialConstructor[one, 0] ENDLOOP;
RETURN[ one ]
}; 
ClassCharacteristic: AC.StructureRankOp = {
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ data.coeffRing.class.characteristic[data.coeffRing] ]
}; 
ClassAdd: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Add[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassNegate: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Negate[polynomial, data.coeffRing] ]
}; 
ClassSubtract: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Subtract[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassMultiply: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Multiply[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassEqual: AC.EqualityOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Equal[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassSign: AC.CompareToZeroOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Sign[polynomial, data.coeffRing] ]
}; 
ClassAbs: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Abs[polynomial, data.coeffRing] ]
}; 
ClassCompare: AC.BinaryCompareOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Compare[firstPoly, secondPoly, data.coeffRing] ]
}; 
ClassRemainder: AC.BinaryOp = {
firstPoly: Polynomial _ NARROW[firstArg];
secondPoly: Polynomial _ NARROW[secondArg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Remainder[firstPoly, secondPoly, structure] ]
}; 
ClassDifferentiate: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
data: PolynomialRingData _ NARROW[structure.instanceData];
RETURN[ Diff[polynomial, data.coeffRing] ]
}; 
ClassLeadingCoefficient: AC.UnaryOp = {
polynomial: Polynomial _ NARROW[arg];
RETURN[ LeadingCoeff[polynomial] ]
}; 
ClassMainVariableDegree: AC.ElementRankOp = {
polynomial: Polynomial _ NARROW[arg];
RETURN[ MainVariableDeg[polynomial] ]
}; 
    polynomialOps: PolynomialOps _ NEW[PolynomialOpsRec _ [
        univariateMonomial: UnivariateMonomialConstructor,
        multivariateMonomial: MultivariateMonomialConstructor,
        differentiate: ClassDifferentiate,
        leadingCoefficient: ClassLeadingCoefficient,
        mainVariableDegree: ClassMainVariableDegree
        ] ];
    polynomialProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$PolynomialRing, polynomialOps]];
    <<structuredProp: Atom.DottedPair _ NEW[Atom.DottedPairNode_ [$Structured, $Structured]];>>
polynomialsOverRingClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [
flavor: ring,
printName: ClassPrintName,
characteristic: ClassCharacteristic,

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

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

    multiply: ClassMultiply,
    commutative: TRUE, -- not necessarily accurate; need separate classrecs for polys over commutative, and polys over noncommutative, 
    rings.
one: ClassOne,

equal: ClassEqual,

    ordered: TRUE, -- not necessarily accurate; need separate classrecs for polys over ordered, and polys over unordered, rings.
    sign: ClassSign,
    abs: ClassAbs,
    compare: ClassCompare,

    integralDomain: TRUE, -- not necessarily accurate; need separate classrecs
    gcdDomain: FALSE, -- not necessarily accurate; need separate classrecs
    gcd: NIL, -- should have a poly gcd proc here when appropriate
    euclideanDomain: FALSE,

propList: LIST[polynomialProp]
    ] ];

polynomialsOverFieldClass: PUBLIC AC.StructureClass _ NEW[AC.StructureClassRec _ [
flavor: ring,
printName: ClassPrintName,
characteristic: ClassCharacteristic,

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

    add: ClassAdd,
    negate: ClassNegate,
    subtract: ClassSubtract,
    multiply: ClassMultiply,
    commutative: TRUE, -- not necessarily accurate; need separate classrecs for polys over commutative, and polys over noncommutative, 
    fields.
one: ClassOne,

equal: ClassEqual,

    ordered: TRUE, -- not necessarily accurate; need separate classrecs for polys over ordered, and polys over unordered, fields.
    sign: ClassSign,
    abs: ClassAbs,
    compare: ClassCompare,

    integralDomain: TRUE, -- not necessarily accurate; need separate classrecs
    gcdDomain: FALSE, -- not necessarily accurate; need separate classrecs
    gcd: NIL, -- should have a poly gcd proc here when appropriate
    euclideanDomain: TRUE,
    remainder: ClassRemainder, -- euclideanDomains only

propList: LIST[polynomialProp]
    ] ];

<<Polynomial Ring Constructors>>

    PolynomialsOverRing: PUBLIC PROC [coeffRing: AC.Structure, V: VARS.VariableSeq] RETURNS [polynomialRing: AC.Structure] ~ {
    <<A particular polynomialRing is defined by its coefficient domain, and its variables.>>
        polynomialRingData: PolynomialRingData _ NEW[PolynomialRingDataRec _ [
            coeffRing: coeffRing,
            variables: V
            ] ];
    polynomialRing _ NEW[AC.StructureRec _ [
    class: polynomialsOverRingClass,
    instanceData: polynomialRingData
        ] ];
        };

    PolynomialsOverField: PUBLIC PROC [coeffField: AC.Structure, V: VARS.VariableSeq] RETURNS [polynomialRing: AC.Structure] ~ {
        polynomialRingData: PolynomialRingData _ NEW[PolynomialRingDataRec _ [
            coeffRing: coeffField,
            variables: V
            ] ];
    polynomialRing _ NEW[AC.StructureRec _ [
    class: polynomialsOverFieldClass,
    instanceData: polynomialRingData
        ] ];
        };
<<Extract Polynomial Operations from Class Property Lists>>
    IsPolynomialRing: PUBLIC PROC [structure: AC.Structure] RETURNS [BOOL] ~ {
        IF Atom.GetPropFromList[structure.class.propList, $PolynomialRing] # NIL THEN RETURN[TRUE] ELSE RETURN[FALSE];
        };

    Differentiate: PUBLIC PROC [polynomialRing: AC.Structure] RETURNS [AC.UnaryOp] ~ {
        polynomialOps: PolynomialOps  _ NARROW[ Atom.GetPropFromList[polynomialRing.class.propList, $PolynomialRing] ];
        IF polynomialOps = NIL THEN ERROR;
        RETURN[polynomialOps.differentiate];
        };

    LeadingCoefficient: PUBLIC PROC [polynomialRing: AC.Structure] RETURNS [AC.UnaryOp] ~ {
        polynomialOps: PolynomialOps  _ NARROW[ Atom.GetPropFromList[polynomialRing.class.propList, $PolynomialRing] ];
        IF polynomialOps = NIL THEN ERROR;
        RETURN[polynomialOps.leadingCoefficient];
        };

    MainVariableDegree: PUBLIC PROC [polynomialRing: AC.Structure] RETURNS [AC.ElementRankOp] ~ {
        polynomialOps: PolynomialOps  _ NARROW[ Atom.GetPropFromList[polynomialRing.class.propList, $PolynomialRing] ];
        IF polynomialOps = NIL THEN ERROR;
        RETURN[polynomialOps.mainVariableDegree];
        };
<<Constructors>>

UnivariateMonomialConstructor: PUBLIC UnivariateMonomialConstructorOp = {
RETURN[ NEW[ PolynomialRec _ [
numVars: 1,
data: nonconstant [ leadingTerm: [ exponent: exp,
coefficient: NEW[ PolynomialRec _ [
numVars: 0,
data: constant [ coeff ]
] ] ],
reductum: ZeroPoly ]
] ] ];
};

MultivariateMonomialConstructor: PUBLIC MultivariateMonomialConstructorOp = {
RETURN[ NEW[ PolynomialRec _ [
numVars: coeff.numVars + 1,
data: nonconstant [ leadingTerm: [ exponent: exp,
coefficient: coeff ],
reductum: ZeroPoly ]
] ] ];
};

<<Conversion and IO>>
<<>>
ReadPoly: PUBLIC PROC [in: IO.STREAM, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [poly: Polynomial] = {
dPoly: DP.DPolynomial;
termChar: CHAR;
[dPoly, termChar] _ DP.ReadDPoly[in, V, coeffRing];
RETURN[ PolyFromDPoly[dPoly, V] ];
};

PolyFromRope: PUBLIC PROC [in: Rope.ROPE, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Polynomial] = {
    stream: IO.STREAM _ IO.RIS[in];
    out _ ReadPoly[stream, V, coeffRing];
    };

PolyFullRepToRope: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Rope.ROPE] = {
<<Dump the internal representation in a more reasonable form than SAC-2 rep>>
    numVars: CARDINAL = V.lengthPlus1 - 1;  -- we need V arg to get this number
IF in = ZeroPoly THEN RETURN["0"];
WITH in SELECT FROM
input: REF PolynomialRec.constant => { 
out _ "";
RETURN[ Rope.Concat[out, coeffRing.class.toRope[input.value, coeffRing] ] ];
};
input: REF PolynomialRec.nonconstant => {
out _ "( ";
WHILE input # ZeroPoly DO
    out _ Rope.Cat[out,
        PolyFullRepToRope[input.leadingTerm.coefficient, VARS.VSRemoveMainVariable[V], coeffRing],
        " ",
        V[numVars],
        Rope.Cat["^", Convert.RopeFromCard[input.leadingTerm.exponent] ]
        ];
    input _ NARROW[input.reductum];
    IF input # ZeroPoly THEN out _ Rope.Concat[ out, " + " ];
    ENDLOOP;
    RETURN[ Rope.Concat[ out, " )" ] ];
    };
    ENDCASE;
    };

PolyToRope: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure, termRope: Rope.ROPE _ DP.DollarRope] RETURNS 
[out: Rope.ROPE] = {
<<Display in a reasonable format>>
out _ DP.DPolyToRope[DPolyFromPoly[in, V], V, coeffRing, termRope];
};

WritePoly: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq, coeffRing: AC.Structure, out: IO.STREAM, termRope: Rope.ROPE _ 
DP.DollarRope] = {
out.PutF["\n %g \n", IO.rope[PolyToRope[in, V, coeffRing, termRope]] ];
};
<<>>
ReadPolySeq: PUBLIC PROC [in: IO.STREAM, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [seq: PolynomialSeq] ~ {
puncChar: CHAR;
    nextP: Polynomial;
    length: NAT _ 0;
ReadPSFail: PUBLIC ERROR [subclass: ATOM _ $Unspecified] = CODE;
pList, pListTail: LIST OF Polynomial _ NIL;
[]_ in.SkipWhitespace[];
puncChar _ in.GetChar[];
IF puncChar # '( THEN ReadPSFail[$LeftParenExpected];
[]_ in.SkipWhitespace[];
WHILE in.PeekChar[]  # ') DO
nextP _ ReadPoly[in, V, coeffRing];
    length _ length + 1;
IF pList=NIL THEN pList _ pListTail _LIST[nextP] ELSE
{ pListTail.rest _ LIST[nextP];  pListTail _ pListTail.rest };
[]_ in.SkipWhitespace[];
    ENDLOOP;
[] _ in.GetChar[];  -- toss right paren
    seq _ NEW[PolynomialSeqRec[length]];
FOR i:NAT IN [1..length+1) DO
seq[i] _ pList.first;
pList _ pList.rest;
ENDLOOP;
    };

PolySeqFromRope: PUBLIC PROC [in: Rope.ROPE, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: PolynomialSeq] ~ {
    PSStream: IO.STREAM _ IO.RIS[in];
    RETURN[ ReadPolySeq[ PSStream, V, coeffRing ] ];
    };

PolySeqToRope: PUBLIC PROC [in: PolynomialSeq, V: VARS.VariableSeq, coeffRing: AC.Structure] RETURNS [out: Rope.ROPE] ~ {
out _ "(\n"; 
FOR i:NAT IN [1..in.lengthPlus1) DO
out _ Rope.Cat[ out, DP.DPolyToRope[DPolyFromPoly[in[i], V], V, coeffRing],"\n"];
ENDLOOP;
out _ Rope.Concat[ out, ")\n" ];
    };

WritePolySeq: PUBLIC PROC [in: PolynomialSeq, V: VARS.VariableSeq, coeffRing: AC.Structure, out: IO.STREAM] ~ {
PSRope: Rope.ROPE _ PolySeqToRope[in, V, coeffRing];
out.PutF["%g", IO.rope[PSRope] ];
};

    PolyFromDPoly: PUBLIC PROC [in: DP.DPolynomial, V: VARS.VariableSeq] RETURNS [out: Polynomial] = {
        numVars: CARDINAL = V.lengthPlus1 - 1;  -- we need V arg to get this number
    termDegree: CARDINAL; -- degree in main variable of current (output) term
    outTermDCoefficient: DP.DPolynomial;  -- output term coefficient, still in DP rep
    outTermCoefficient: Polynomial; -- output term coefficient, converted to P rep
        outTerm: Polynomial; -- completed output term
        previousTerm: Polynomial;
    IF in = DP.ZeroDPoly THEN RETURN[ZeroPoly];
    IF numVars=0 THEN {
    out _ NEW[PolynomialRec _ [
    numVars: 0,
    data: constant[value: in.first.coefficient]
    ] ];
    RETURN;
    };
    previousTerm _ ZeroPoly;
    WHILE in#NIL DO
    termDegree _ DP.DVDegree[in.first.degreeVector, numVars]; -- degree in main variable
    outTermDCoefficient _ LIST[ [in.first.coefficient, DP.DVRemoveMainVariablePower[in.first.degreeVector, numVars] ] ];
    in _ in.rest;
    WHILE in#NIL AND DP.DVDegree[in.first.degreeVector, numVars] = termDegree DO
    outTermDCoefficient _ CONS[ [in.first.coefficient, DP.DVRemoveMainVariablePower[in.first.degreeVector, numVars] ], 
    outTermDCoefficient];
    in _ in.rest;
    ENDLOOP;
    outTermDCoefficient _ DP.DPReverse[ outTermDCoefficient ];
    outTermCoefficient _ PolyFromDPoly[ outTermDCoefficient, VARS.VSRemoveMainVariable[V] ];
    outTerm _ NEW[PolynomialRec _ [
    numVars: numVars,
    data: nonconstant [ leadingTerm: [ exponent: termDegree,
    coefficient: outTermCoefficient ],
    reductum: ZeroPoly ]
    ] ];
        IF previousTerm # ZeroPoly THEN {
            WITH previousTerm SELECT FROM
                previousTermVariant: REF PolynomialRec.nonconstant => {
                    previousTermVariant.reductum _ outTerm;
                    previousTerm _ outTerm;
                    };
                ENDCASE => ERROR;
            }
        ELSE out _ previousTerm _ outTerm;
        ENDLOOP;
        };

    DPolyFromPoly: PUBLIC PROC [in: Polynomial, V: VARS.VariableSeq] RETURNS [out: DP.DPolynomial] ~ {
        numVars: CARDINAL = V.lengthPlus1 - 1;  -- we need V arg to get this number
    inTermDegree: CARDINAL; -- degree in main variable of current (input) term
    inTermDPolynomial: DP.DPolynomial;
    IF in = ZeroPoly THEN RETURN[DP.ZeroDPoly];
        IF numVars#in.numVars THEN ERROR; -- consistency check
    WITH in SELECT FROM
    input: REF PolynomialRec.constant => RETURN[ LIST[ [input.value, NIL] ] ];
    input: REF PolynomialRec.nonconstant => {
    out _ DP.ZeroDPoly;
    WHILE input # ZeroPoly DO
        inTermDegree _ input.leadingTerm.exponent;
    inTermDPolynomial _ DPolyFromPoly[input.leadingTerm.coefficient, VARS.VSRemoveMainVariable[V] ];
    WHILE inTermDPolynomial#NIL DO
    out _ CONS[ [ inTermDPolynomial.first.coefficient, DP.DVAddMainVariablePower[inTermDPolynomial.first.degreeVector, numVars, 
    inTermDegree] ], out];
    inTermDPolynomial _ inTermDPolynomial.rest;
    ENDLOOP;
    input _ NARROW[ input.reductum ];
    ENDLOOP;
    out _  DP.DPReverse[out];
    };
    ENDCASE;
        };

<<Arithmetic>>

Add: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
previousOutTerm, outTerm, tail: Polynomial;
termToAdd: BOOL;
IF in1 = ZeroPoly THEN RETURN[in2];
IF in2 = ZeroPoly THEN RETURN[in1];
IF in1.numVars # in2.numVars THEN ERROR;
WITH in1 SELECT FROM
input1: REF PolynomialRec.constant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.constant => {
val: REF _ coeffRing.class.add[input1.value, input2.value, coeffRing];
IF coeffRing.class.equal[val, coeffRing.class.zero[coeffRing], coeffRing] THEN RETURN[ZeroPoly];
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: val]
] ];
RETURN;
};
ENDCASE => ERROR;
};
input1: REF PolynomialRec.nonconstant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.nonconstant => {
out _ previousOutTerm _ ZeroPoly;
WHILE input1 # ZeroPoly AND input2 # ZeroPoly DO
termToAdd _ TRUE;
    SELECT input1.leadingTerm.exponent FROM
        < input2.leadingTerm.exponent => {
        outTerm _ NEW[PolynomialRec _ [
        numVars: input2.numVars,
        data: nonconstant[leadingTerm: input2.leadingTerm, reductum: ZeroPoly]
        ] ]; 
        input2 _ NARROW[ input2.reductum ];
        };
    > input2.leadingTerm.exponent => {
    outTerm _ NEW[PolynomialRec _ [
    numVars: input1.numVars,
    data: nonconstant [leadingTerm: input1.leadingTerm, reductum: ZeroPoly ]
    ] ];
    input1 _ NARROW[ input1.reductum ];
    };
    = input2.leadingTerm.exponent => {
    coeff: Polynomial _ Add[
    input1.leadingTerm.coefficient,
    input2.leadingTerm.coefficient,
    coeffRing
    ];
    IF coeff # ZeroPoly THEN
    outTerm _ NEW[PolynomialRec _ [
    numVars: input1.numVars,
    data: nonconstant [ leadingTerm: [ exponent: input2.leadingTerm.exponent,
    coefficient: coeff ],
    reductum: ZeroPoly ]
    ] ]
    ELSE
    termToAdd _ FALSE;
    input1 _ NARROW[ input1.reductum ];
    input2 _ NARROW[ input2.reductum ];
    };
        ENDCASE;
    IF termToAdd THEN IF previousOutTerm # ZeroPoly THEN {
        WITH previousOutTerm SELECT FROM
            previousOutTermVariant: REF PolynomialRec.nonconstant => {
                previousOutTermVariant.reductum _ outTerm;
                previousOutTerm _ outTerm;
                };
            ENDCASE => ERROR;
        }
        ELSE out _ previousOutTerm _ outTerm;
    ENDLOOP;
    IF input1 = ZeroPoly THEN tail _ input2 ELSE tail _ input1;
    IF out # ZeroPoly THEN WITH previousOutTerm SELECT FROM
        previousOutTermVariant: REF PolynomialRec.nonconstant => previousOutTermVariant.reductum _ tail;
        ENDCASE => ERROR
    ELSE out _ tail;
    };
    ENDCASE => ERROR;
    };
    ENDCASE;
    };

Negate: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
outTerm, previousOutTerm: Polynomial;
IF in = ZeroPoly THEN RETURN[ZeroPoly];
WITH in SELECT FROM
input: REF PolynomialRec.constant => {
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: coeffRing.class.negate[input.value, coeffRing] ]
] ];
RETURN;
};
input: REF PolynomialRec.nonconstant => {
previousOutTerm _ ZeroPoly;
WHILE input # ZeroPoly DO
outTerm _ NEW[PolynomialRec _ [
numVars: input.numVars,
data: nonconstant[leadingTerm: [
exponent: input.leadingTerm.exponent,
coefficient: Negate[input.leadingTerm.coefficient, coeffRing]
],
reductum: ZeroPoly ]
] ]; 
input _ NARROW[input.reductum ];
    IF previousOutTerm # ZeroPoly THEN {
        WITH previousOutTerm SELECT FROM
            previousOutTermVariant: REF PolynomialRec.nonconstant => {
                previousOutTermVariant.reductum _ outTerm;
                previousOutTerm _ outTerm;
                };
            ENDCASE => ERROR;
        }
        ELSE out _ previousOutTerm _ outTerm;
ENDLOOP;
};
ENDCASE;
    };

Subtract: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [Polynomial] ~ {
RETURN[ Add[ in1, Negate[ in2, coeffRing], coeffRing ] ];
};

Multiply: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
previousOutSummandTerm, outSummandTerm, outSummand: Polynomial;
IF in1 = ZeroPoly OR in2 = ZeroPoly THEN RETURN[ZeroPoly];
IF in1.numVars # in2.numVars THEN ERROR;
WITH in1 SELECT FROM
input1: REF PolynomialRec.constant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.constant => {
val: REF _ coeffRing.class.multiply[input1.value, input2.value, coeffRing];
out _ NEW[PolynomialRec _ [
numVars: 0,
data: constant[value: val]
] ];
RETURN;
};
ENDCASE => ERROR;
};
input1: REF PolynomialRec.nonconstant => {
WITH in2 SELECT FROM
input2: REF PolynomialRec.nonconstant => {
scratchInput1: REF PolynomialRec.nonconstant;
out _ ZeroPoly;
WHILE input2 # ZeroPoly DO
previousOutSummandTerm _ ZeroPoly;
scratchInput1 _  input1;
WHILE scratchInput1 # ZeroPoly DO
coeff: Polynomial _ Multiply[
scratchInput1.leadingTerm.coefficient,
input2.leadingTerm.coefficient,
coeffRing
];
outSummandTerm _ NEW[PolynomialRec _ [
numVars: scratchInput1.numVars,
data: nonconstant [ leadingTerm: [
exponent: scratchInput1.leadingTerm.exponent + input2.leadingTerm.exponent,
coefficient: coeff ],
reductum: ZeroPoly ]
] ];
    IF previousOutSummandTerm # ZeroPoly THEN
        WITH previousOutSummandTerm SELECT FROM
            previousOutSummandTermVariant: REF PolynomialRec.nonconstant => {
                previousOutSummandTermVariant.reductum _ outSummandTerm;
                previousOutSummandTerm _ outSummandTerm;
                };
            ENDCASE => ERROR
    ELSE outSummand _ previousOutSummandTerm _ outSummandTerm;
scratchInput1 _ NARROW[ scratchInput1.reductum ];
ENDLOOP;
out _ Add[out, outSummand, coeffRing];
input2 _ NARROW[ input2.reductum ];
ENDLOOP;
};
    ENDCASE => ERROR
    };
    ENDCASE;
    };

Remainder: PUBLIC PROC [dividend, divisor: Polynomial, polynomialsOverField: AC.Structure] RETURNS [Polynomial] ~ {
<<Note that structure arg is poly ring, not coefficient ring>>
R: AC.Structure = polynomialsOverField;
newDividend: Polynomial _ dividend;
data: PolynomialRingData _ NARROW[R.instanceData];
IF data.coeffRing.class.flavor # field AND data.coeffRing.class.flavor # divisionAlgebra THEN ERROR;
WHILE MainVariableDeg[newDividend] >= MainVariableDeg[divisor] DO
coeff: REF _ data.coeffRing.class.divide[LeadingCoeff[newDividend], LeadingCoeff[divisor] ];
degreeDelta: CARDINAL _ MainVariableDeg[newDividend] - MainVariableDeg[divisor];
multiplier: Polynomial _ UnivariateMonomialConstructor[coeff, degreeDelta];
product: Polynomial _ NARROW[R.class.multiply[multiplier, divisor, R]];
newDividend _ NARROW[R.class.subtract[newDividend, product, R]];
ENDLOOP;
RETURN[newDividend];
};

 
Diff: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
<<Assumes that CARDINAL exponent values can be imbedded in coeffRing, in particular, that 
coeffRing.class.fromRope[Convert.RopeFromCard[input.leadingTerm.exponent]] works.>>
outTerm, previousOutTerm: Polynomial;
IF in = ZeroPoly THEN RETURN[ZeroPoly];
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[ZeroPoly];
input: REF PolynomialRec.nonconstant => {
numV: CARDINAL = input.numVars;
out _ previousOutTerm _ ZeroPoly;
WHILE input # ZeroPoly AND input.leadingTerm.exponent > 0 DO
imbeddedExp: REF _ coeffRing.class.fromRope[Convert.RopeFromCard[input.leadingTerm.exponent,10, FALSE] ];
    IF input.numVars = 1 THEN {
    newCoeff: REF _ coeffRing.class.multiply[imbeddedExp, LeadingCoeff[input], coeffRing];
        outTerm _ UnivariateMonomialConstructor[newCoeff, input.leadingTerm.exponent-1]
        }
    ELSE {
        newCoeff: Polynomial;
        newImbeddedExp: Polynomial _ UnivariateMonomialConstructor[imbeddedExp, 0];
        FOR i:INT IN [2 .. input.numVars-1] DO newImbeddedExp _ MultivariateMonomialConstructor[newImbeddedExp, 0] ENDLOOP;
        newCoeff _ Multiply[newImbeddedExp, NARROW[LeadingCoeff[input]], coeffRing];
        outTerm _ MultivariateMonomialConstructor[newCoeff, input.leadingTerm.exponent-1]
        };
input _ NARROW[input.reductum];
    IF previousOutTerm # ZeroPoly THEN {
        WITH previousOutTerm SELECT FROM
            previousOutTermVariant: REF PolynomialRec.nonconstant => {
                previousOutTermVariant.reductum _ outTerm;
                previousOutTerm _ outTerm;
                };
            ENDCASE => ERROR;
        }
        ELSE out _ previousOutTerm _ outTerm;
ENDLOOP;
};
ENDCASE;
    };

<<Comparison>>
Equal: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [BOOL _ FALSE] ~ {
WITH in1 SELECT FROM
input: REF PolynomialRec.constant =>
RETURN[coeffRing.class.subtract[in1, in2, coeffRing] = ZeroPoly];
input: REF PolynomialRec.nonconstant => 
RETURN[Subtract[in1, in2, coeffRing] = ZeroPoly ];
ENDCASE;
    };

Sign: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [Basics.Comparison _ equal] ~ {
IF in = ZeroPoly THEN RETURN[equal];
    <<IF NOT AC.IsOrdered[coeffRing] THEN ERROR;>>
WITH in SELECT FROM
input: REF PolynomialRec.constant =>
RETURN[coeffRing.class.sign[input.value, coeffRing] ];
input: REF PolynomialRec.nonconstant => 
RETURN[Sign[input.leadingTerm.coefficient, coeffRing] ];
ENDCASE;
    };

Abs: PUBLIC PROC [in: Polynomial, coeffRing: AC.Structure] RETURNS [out: Polynomial] ~ {
sign: Basics.Comparison _ Sign[in, coeffRing];
IF sign = less THEN RETURN[Negate[in, coeffRing]] ELSE RETURN[in];
    };

    Compare: PUBLIC PROC [in1, in2: Polynomial, coeffRing: AC.Structure] RETURNS [Basics.Comparison] ~ {
    diff: Polynomial _ Subtract[in1, in2, coeffRing];
    SELECT Sign[diff, coeffRing] FROM
    less => RETURN[less];    
    equal => RETURN[equal];
    ENDCASE;
    RETURN[greater];
        };
<<Selection>>
LeadingCoeff: PUBLIC PROC [in: Polynomial] RETURNS [out: REF _ NIL] ~ {
IF in = ZeroPoly THEN RETURN[ZeroPoly];
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[input.value];
input: REF PolynomialRec.nonconstant => {
    SELECT in.numVars FROM
        1 => RETURN[LeadingCoeff[input.leadingTerm.coefficient]]; -- extract ground ring elt
        ENDCASE => RETURN[input.leadingTerm.coefficient];
    };
    ENDCASE;
};
<<>>
MainVariableDeg: PUBLIC PROC [in: Polynomial] RETURNS [CARDINAL _ 0] ~ {
IF in = ZeroPoly THEN RETURN[0];
WITH in SELECT FROM
input: REF PolynomialRec.constant => RETURN[0];
input: REF PolynomialRec.nonconstant => RETURN[input.leadingTerm.exponent];
ENDCASE;
};


END.