<> <> <<>> DIRECTORY Rope, IO, Basics, MathExpr, MathConstructors, AlgebraClasses, Ints, Expressions; ExpressionsImpl: CEDAR PROGRAM IMPORTS Rope, IO, MathConstructors, MathExpr, AlgebraClasses, Ints EXPORTS Expressions = BEGIN OPEN AC: AlgebraClasses, Expressions; <> MeddleExprsError: PUBLIC SIGNAL [reason: ATOM _ $Unspecified] = CODE; ROPE: TYPE = Rope.ROPE; Object: TYPE = AC.Object; Method: TYPE = AC.Method; EXPR: TYPE ~ MathExpr.EXPR; MathExprRep: TYPE ~ MathExpr.MathExprRep; AtomEXPR: TYPE ~ MathExpr.AtomEXPR; CompoundEXPR: TYPE ~ MathExpr.CompoundEXPR; MatrixEXPR: TYPE ~ MathExpr.MatrixEXPR; TaggedMathExpr: TYPE ~ MathExpr.TaggedMathExpr; ExprFlavors: TYPE ~ MathExpr.ExprFlavors; AtomClass: TYPE ~ MathExpr.AtomClass; AtomClassRep: TYPE ~ MathExpr.AtomClassRep; AtomFlavor: TYPE ~ MathExpr.AtomFlavor; CompoundClass: TYPE ~ MathExpr.CompoundClass; CompoundClassRep: TYPE ~ MathExpr.CompoundClassRep; MatrixClass: TYPE ~ MathExpr.MatrixClass; MatrixClassRep: TYPE ~ MathExpr.MatrixClassRep; Argument: TYPE ~ MathExpr.Argument; Symbol: TYPE ~ MathExpr.Symbol; <> PrintName: PUBLIC AC.PrintNameProc = { RETURN["MeddleExprs"]; }; ShortPrintName: PUBLIC AC.PrintNameProc = { RETURN["MExprs"]; }; IsExprs: PUBLIC AC.UnaryPredicate = { RETURN[AC.StructureEqual[arg, MeddleExprs] ]; }; <> Recast: PUBLIC AC.BinaryOp = { RETURN[FromExpr[AC.ApplyLkpNoRecastExpr[$toExpr, firstArg.class, LIST[firstArg] ], MeddleExprs ] ]; }; CanRecast: PUBLIC AC.BinaryPredicate = { RETURN[TRUE]; }; ToExpr: PUBLIC AC.ToExprOp = { RETURN[NARROW[in.data] ]; }; FromExpr: PUBLIC AC.FromExprOp = { RETURN[NEW[AC.ObjectRec _ [ flavor: StructureElement, class: MeddleExprs, data: in ] ] ]; }; LegalFirstChar: PUBLIC AC.LegalFirstCharOp = { RETURN[char='(]; }; Read: PUBLIC AC.ReadOp ~ { RETURN[FromExpr[MathExpr.ExprFromStream[in], MeddleExprs] ]; }; FromRope: PUBLIC AC.FromRopeOp = { stream: IO.STREAM _ IO.RIS[in]; RETURN[ Read[stream, structure] ]; }; ToRope: PUBLIC AC.ToRopeOp = { data: MeddleExprData _ NARROW[in.data]; RETURN[ MathExpr.RopeFromExpr[data] ]; }; Write: PUBLIC AC.WriteOp = { IO.PutRope[ stream, ToRope[in] ] }; <> Zero: PUBLIC AC.NullaryOp = { RETURN[ FromExpr[MathConstructors.MakeInt["0"], MeddleExprs ] ] }; One: PUBLIC AC.NullaryOp = { RETURN[ FromExpr[MathConstructors.MakeInt["1"], MeddleExprs ] ] }; Add: PUBLIC AC.BinaryOp ~ { firstData: MeddleExprData _ NARROW[firstArg.data]; secondData: MeddleExprData _ NARROW[secondArg.data]; RETURN[FromExpr[MathConstructors.MakeSum[firstData, secondData], MeddleExprs] ]; }; Negate: PUBLIC AC.UnaryOp ~ { data: MeddleExprData _ NARROW[arg.data]; RETURN[FromExpr[MathConstructors.MakeNegation[data], MeddleExprs] ]; }; Subtract: PUBLIC AC.BinaryOp ~ { firstData: MeddleExprData _ NARROW[firstArg.data]; secondData: MeddleExprData _ NARROW[secondArg.data]; RETURN[FromExpr[MathConstructors.MakeDifference[firstData, secondData], MeddleExprs] ]; }; Multiply: PUBLIC AC.BinaryOp ~ { firstData: MeddleExprData _ NARROW[firstArg.data]; secondData: MeddleExprData _ NARROW[secondArg.data]; RETURN[FromExpr[MathConstructors.MakeProduct[firstData, secondData], MeddleExprs] ]; }; Power: PUBLIC AC.BinaryOp ~ { -- this simple algorithm is Structure independent power: INT _ Ints.ToINT[secondArg]; structure: Object _ firstArg.class; one: Object _ AC.ApplyLkpNoRecastObject[$one, structure, LIST[structure] ]; productMethod: Method _ AC.LookupMethodInStructure[$product, structure]; IF power < 0 THEN { invertMethod: Method _ AC.LookupMethodInStructure[$invert, structure]; temp: Object; IF invertMethod = NIL THEN ERROR; temp _ Power[firstArg, Ints.FromINT[ABS[power] ] ]; RETURN[AC.ApplyNoLkpNoRecastObject[invertMethod, LIST[temp] ] ]; }; IF power = 0 THEN RETURN[one]; result _ firstArg; FOR i:INT IN [2..power] DO result _ AC.ApplyNoLkpNoRecastObject[productMethod, LIST[firstArg, result] ]; ENDLOOP; }; Divide: PUBLIC AC.BinaryOp ~ { firstData: MeddleExprData _ NARROW[firstArg.data]; secondData: MeddleExprData _ NARROW[secondArg.data]; RETURN[FromExpr[MathConstructors.MakeFraction[firstData, secondData], MeddleExprs] ]; }; <> Equal: PUBLIC AC.BinaryPredicate ~ { firstData: EXPR _ NARROW[firstArg.data]; secondData: EXPR _ NARROW[secondArg.data]; RETURN[EqualSubr[firstData, secondData] ]; }; EqualSubr: PROC [firstData, secondData: EXPR] RETURNS[BOOL] ~ { WITH firstData SELECT FROM a: AtomEXPR => { b: AtomEXPR; IF NOT ISTYPE[secondData, AtomEXPR] THEN RETURN[FALSE] ELSE b_ NARROW[secondData]; IF a.class.name # b.class.name THEN RETURN[FALSE]; IF NOT Rope.Equal[a.value, b.value] THEN RETURN[FALSE]; RETURN[TRUE]; }; c: CompoundEXPR => { d: CompoundEXPR; IF NOT ISTYPE[secondData, CompoundEXPR] THEN RETURN[FALSE] ELSE d_ NARROW[secondData]; IF c.class.name # d.class.name THEN RETURN[FALSE]; <> FOR l: LIST OF Argument _ c.class.arguments, l.rest UNTIL l = NIL DO cArg: EXPR_ MathExpr.GetTaggedExpr[l.first.name, c.subExprs].expression; dArg: EXPR_ MathExpr.GetTaggedExpr[l.first.name, d.subExprs].expression; IF NOT EqualSubr[cArg, dArg] THEN RETURN[FALSE]; ENDLOOP; RETURN[TRUE]; }; m: MatrixEXPR => { n: MatrixEXPR; l: LIST OF TaggedMathExpr; IF NOT ISTYPE[secondData, MatrixEXPR] THEN RETURN[FALSE] ELSE n_ NARROW[secondData]; IF m.class.name # n.class.name THEN RETURN[FALSE]; <> l _ n.elements; FOR k: LIST OF TaggedMathExpr _ m.elements, k.rest UNTIL k = NIL DO IF NOT EqualSubr[k.first.expression, l.first.expression] THEN RETURN[FALSE]; l _ l.rest; ENDLOOP; RETURN[TRUE]; }; ENDCASE => ERROR; }; <> MeddleExprsDesired: PUBLIC AC.UnaryToListOp ~ { <> RETURN[ LIST[MeddleExprs] ]; }; <> MeddleExprClass: Object _ AC.MakeClass["MeddleExprClass", NIL, NIL]; MeddleExprs: PUBLIC Object _ AC.MakeStructure["MeddleExprs", MeddleExprClass, NIL]; categoryMethod: Method _ AC.MakeMethod[Value, FALSE, NEW[AC.Category _ ring], NIL, "category"]; groundStructureMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "groundStructure"]; expressionStructureMethod: Method _ AC.MakeMethod[Value, FALSE, NIL, NIL, "expressionStructure"]; shortPrintNameMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ShortPrintName], NIL, "shortPrintName"]; recastMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Recast], NIL, "recast"]; canRecastMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ CanRecast], NIL, "canRecast"]; toExprMethod: Method _ AC.MakeMethod[ToExprOp, TRUE, NEW[AC.ToExprOp _ ToExpr], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "toExpr"]; fromExprMethod: Method _ AC.MakeMethod[FromExprOp, TRUE, NEW[AC.FromExprOp _ FromExpr], NIL, "fromExpr"]; legalFirstCharMethod: Method _ AC.MakeMethod[LegalFirstCharOp, FALSE, NEW[AC.LegalFirstCharOp _ LegalFirstChar], NIL, "legalFirstChar"]; readMethod: Method _ AC.MakeMethod[ReadOp, FALSE, NEW[AC.ReadOp _ Read], NIL, "read"]; fromRopeMethod: Method _ AC.MakeMethod[FromRopeOp, TRUE, NEW[AC.FromRopeOp _ FromRope], NIL, "fromRope"]; toRopeMethod: Method _ AC.MakeMethod[ToRopeOp, FALSE, NEW[AC.ToRopeOp _ ToRope], NIL, "toRope"]; parenMethod: Method _ AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp _ AC.Copy], NIL, "paren"]; zeroMethod: Method _ AC.MakeMethod[NullaryOp, FALSE, NEW[AC.NullaryOp _ Zero], NIL, "zero"]; oneMethod: Method _ AC.MakeMethod[NullaryOp, FALSE, NEW[AC.NullaryOp _ One], NIL, "one"]; sumMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Add], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "sum"]; negationMethod: Method _ AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp _ Negate], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "negation"]; differenceMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Subtract], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "difference"]; productMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Multiply], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "product"]; powerMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Power], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "power"]; fractionMethod: Method _ AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp _ Divide], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "fraction"]; equalMethod: Method _ AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate _ Equal], NEW[AC.UnaryToListOp _ MeddleExprsDesired], "equals"]; AC.AddMethodToClass[$category, categoryMethod, MeddleExprClass]; AC.AddMethodToClass[$groundStructure, categoryMethod, MeddleExprClass]; AC.AddMethodToClass[$expressionStructure, expressionStructureMethod, MeddleExprClass]; AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, MeddleExprClass]; AC.AddMethodToClass[$recast, recastMethod, MeddleExprClass]; AC.AddMethodToClass[$canRecast, canRecastMethod, MeddleExprClass]; AC.AddMethodToClass[$toExpr, toExprMethod, MeddleExprClass]; AC.AddMethodToClass[$fromExpr, fromExprMethod, MeddleExprClass]; AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, MeddleExprClass]; AC.AddMethodToClass[$read, readMethod, MeddleExprClass]; AC.AddMethodToClass[$fromRope, fromRopeMethod, MeddleExprClass]; AC.AddMethodToClass[$toRope, toRopeMethod, MeddleExprClass]; AC.AddMethodToClass[$paren, parenMethod, MeddleExprClass]; AC.AddMethodToClass[$zero, zeroMethod, MeddleExprClass]; AC.AddMethodToClass[$one, oneMethod, MeddleExprClass]; AC.AddMethodToClass[$sum, sumMethod, MeddleExprClass]; AC.AddMethodToClass[$negation, negationMethod, MeddleExprClass]; AC.AddMethodToClass[$difference, differenceMethod, MeddleExprClass]; AC.AddMethodToClass[$product, productMethod, MeddleExprClass]; AC.AddMethodToClass[$pow, powerMethod, MeddleExprClass]; AC.AddMethodToClass[$fraction, fractionMethod, MeddleExprClass]; AC.AddMethodToClass[$eqFormula, equalMethod, MeddleExprClass]; <> END.