<> <> <<>> DIRECTORY Rope, IO, Basics, MathExpr, MathConstructors, AlgebraClasses, ASExprs; ASExprsImpl: CEDAR PROGRAM IMPORTS Rope, IO, MathConstructors, MathExpr, AlgebraClasses EXPORTS ASExprs = BEGIN OPEN ASExprs; <> ASExprsError: PUBLIC SIGNAL [reason: ATOM _ $Unspecified] = CODE; ROPE: TYPE = Rope.ROPE; Object: TYPE = AlgebraClasses.Object; Method: TYPE = AlgebraClasses.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; <> ASExprDataRep: TYPE ~ RECORD [ SELECT type:* FROM atomic => [ op: ATOM, -- type of entity, e.g. $integer, $real, $symbol (our notion of a symbol is essentially that of an "identifier", i.e. a legal "name" which is capable of having an associated value), $string, $char value: ROPE -- atomic value, e.g. integer as rope. Any legal name (e.g. Greek letter, subscripted variable, etc.) should be an atomic Expr of type $symbol (or we can have types $greekSymbol, $decoratedSymbol, etc., or $name ...). Better to have just one type $symbol, and plan to parse it to determine possible subcomponents, and so the right display. ], composite => [ op: ATOM, -- operator args: LIST OF Object _ NIL -- operands ] ENDCASE ]; ASExprData: TYPE ~ REF ASExprDataRep; -- inside impl module, use rep <> <> <> PrintName: PUBLIC AlgebraClasses.PrintNameProc = { RETURN["ASExprs"]; }; ShortPrintName: PUBLIC AlgebraClasses.PrintNameProc = { RETURN["ASExprs"]; }; IsExprs: PUBLIC AlgebraClasses.UnaryPredicate = { RETURN[AlgebraClasses.StructureEqual[arg, ASExprs] ]; }; <> Recast: PUBLIC AlgebraClasses.BinaryOp = { RETURN[FromEXPR[AlgebraClasses.ApplyLkpNoRecastExpr[$toExpr, firstArg.class, LIST[firstArg] ], ASExprs ] ]; }; CanRecast: PUBLIC AlgebraClasses.BinaryPredicate = { RETURN[TRUE]; }; ToEXPR: PUBLIC AlgebraClasses.ToEXPROp = { RETURN[NARROW[in.data] ]; }; FromEXPR: PUBLIC AlgebraClasses.FromEXPROp = { RETURN[NEW[AlgebraClasses.ObjectRec _ [ flavor: StructureElement, class: ASExprs, data: in ] ] ]; }; LegalFirstChar: PUBLIC AlgebraClasses.LegalFirstCharOp = { RETURN[char='(]; }; Read: PUBLIC AlgebraClasses.ReadOp ~ { RETURN[FromEXPR[MathExpr.ExprFromStream[in], ASExprs] ]; }; FromRope: PUBLIC AlgebraClasses.FromRopeOp = { stream: IO.STREAM _ IO.RIS[in]; RETURN[ Read[stream, structure] ]; }; ToRope: PUBLIC AlgebraClasses.ToRopeOp = { data: ASExprData _ NARROW[in.data]; RETURN[ MathExpr.RopeFromEXPR[data] ]; }; Write: PUBLIC AlgebraClasses.WriteOp = { IO.PutRope[ stream, ToRope[in] ] }; <> Zero: PUBLIC AlgebraClasses.NullaryOp = { RETURN[ FromEXPR[MathConstructors.MakeInt["0"], ASExprs ] ] }; One: PUBLIC AlgebraClasses.NullaryOp = { RETURN[ FromEXPR[MathConstructors.MakeInt["1"], ASExprs ] ] }; Add: PUBLIC AlgebraClasses.BinaryOp ~ { firstData: ASExprData _ NARROW[firstArg.data]; secondData: ASExprData _ NARROW[secondArg.data]; RETURN[FromEXPR[MathConstructors.MakeSum[firstData, secondData], ASExprs] ]; }; Negate: PUBLIC AlgebraClasses.UnaryOp ~ { data: ASExprData _ NARROW[arg.data]; RETURN[FromEXPR[MathConstructors.MakeNegation[data], ASExprs] ]; }; Subtract: PUBLIC AlgebraClasses.BinaryOp ~ { firstData: ASExprData _ NARROW[firstArg.data]; secondData: ASExprData _ NARROW[secondArg.data]; RETURN[FromEXPR[MathConstructors.MakeDifference[firstData, secondData], ASExprs] ]; }; Multiply: PUBLIC AlgebraClasses.BinaryOp ~ { firstData: ASExprData _ NARROW[firstArg.data]; secondData: ASExprData _ NARROW[secondArg.data]; RETURN[FromEXPR[MathConstructors.MakeProduct[firstData, secondData], ASExprs] ]; }; Power: PUBLIC AlgebraClasses.BinaryOp ~ { -- this simple algorithm is Structure independent firstData: ASExprData _ NARROW[firstArg.data]; secondData: ASExprData _ NARROW[secondArg.data]; RETURN[FromEXPR[MathConstructors.MakePow[firstData, secondData], ASExprs] ]; }; Divide: PUBLIC AlgebraClasses.BinaryOp ~ { firstData: ASExprData _ NARROW[firstArg.data]; secondData: ASExprData _ NARROW[secondArg.data]; RETURN[FromEXPR[MathConstructors.MakeFraction[firstData, secondData], ASExprs] ]; }; <> Equal: PUBLIC AlgebraClasses.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; }; <> ASExprsDesired: PUBLIC AlgebraClasses.UnaryToListOp ~ { <> RETURN[ LIST[ASExprs] ]; }; <> ASExprClass: PUBLIC Object _ AlgebraClasses.MakeClass["ASExprClass", NIL, NIL]; ASExprs: PUBLIC Object _ AlgebraClasses.MakeStructure["ASExprs", ASExprClass, NIL]; categoryMethod: Method _ AlgebraClasses.MakeMethod[Value, FALSE, NEW[AlgebraClasses.Category _ ring], NIL, "category"]; groundStructureMethod: Method _ AlgebraClasses.MakeMethod[Value, FALSE, NIL, NIL, "groundStructure"]; expressionStructureMethod: Method _ AlgebraClasses.MakeMethod[Value, FALSE, NIL, NIL, "expressionStructure"]; shortPrintNameMethod: Method _ AlgebraClasses.MakeMethod[ToRopeOp, FALSE, NEW[AlgebraClasses.ToRopeOp _ ShortPrintName], NIL, "shortPrintName"]; recastMethod: Method _ AlgebraClasses.MakeMethod[BinaryOp, TRUE, NEW[AlgebraClasses.BinaryOp _ Recast], NIL, "recast"]; canRecastMethod: Method _ AlgebraClasses.MakeMethod[BinaryPredicate, TRUE, NEW[AlgebraClasses.BinaryPredicate _ CanRecast], NIL, "canRecast"]; toExprMethod: Method _ AlgebraClasses.MakeMethod[ToEXPROp, FALSE, NEW[AlgebraClasses.ToEXPROp _ ToEXPR], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "toExpr"]; fromExprMethod: Method _ AlgebraClasses.MakeMethod[FromEXPROp, FALSE, NEW[AlgebraClasses.FromEXPROp _ FromEXPR], NIL, "fromExpr"]; legalFirstCharMethod: Method _ AlgebraClasses.MakeMethod[LegalFirstCharOp, FALSE, NEW[AlgebraClasses.LegalFirstCharOp _ LegalFirstChar], NIL, "legalFirstChar"]; readMethod: Method _ AlgebraClasses.MakeMethod[ReadOp, FALSE, NEW[AlgebraClasses.ReadOp _ Read], NIL, "read"]; fromRopeMethod: Method _ AlgebraClasses.MakeMethod[FromRopeOp, TRUE, NEW[AlgebraClasses.FromRopeOp _ FromRope], NIL, "fromRope"]; toRopeMethod: Method _ AlgebraClasses.MakeMethod[ToRopeOp, FALSE, NEW[AlgebraClasses.ToRopeOp _ ToRope], NIL, "toRope"]; parenMethod: Method _ AlgebraClasses.MakeMethod[UnaryOp, FALSE, NEW[AlgebraClasses.UnaryOp _ AlgebraClasses.Copy], NIL, "paren"]; zeroMethod: Method _ AlgebraClasses.MakeMethod[NullaryOp, FALSE, NEW[AlgebraClasses.NullaryOp _ Zero], NIL, "zero"]; oneMethod: Method _ AlgebraClasses.MakeMethod[NullaryOp, FALSE, NEW[AlgebraClasses.NullaryOp _ One], NIL, "one"]; sumMethod: Method _ AlgebraClasses.MakeMethod[BinaryOp, TRUE, NEW[AlgebraClasses.BinaryOp _ Add], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "sum"]; negationMethod: Method _ AlgebraClasses.MakeMethod[UnaryOp, TRUE, NEW[AlgebraClasses.UnaryOp _ Negate], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "negation"]; differenceMethod: Method _ AlgebraClasses.MakeMethod[BinaryOp, TRUE, NEW[AlgebraClasses.BinaryOp _ Subtract], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "difference"]; productMethod: Method _ AlgebraClasses.MakeMethod[BinaryOp, TRUE, NEW[AlgebraClasses.BinaryOp _ Multiply], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "product"]; powerMethod: Method _ AlgebraClasses.MakeMethod[BinaryOp, TRUE, NEW[AlgebraClasses.BinaryOp _ Power], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "power"]; fractionMethod: Method _ AlgebraClasses.MakeMethod[BinaryOp, TRUE, NEW[AlgebraClasses.BinaryOp _ Divide], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "fraction"]; equalMethod: Method _ AlgebraClasses.MakeMethod[BinaryPredicate, TRUE, NEW[AlgebraClasses.BinaryPredicate _ Equal], NEW[AlgebraClasses.UnaryToListOp _ ASExprsDesired], "equals"]; AlgebraClasses.AddMethodToClass[$category, categoryMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$groundStructure, categoryMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$expressionStructure, expressionStructureMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$shortPrintName, shortPrintNameMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$recast, recastMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$canRecast, canRecastMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$toExpr, toExprMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$fromExpr, fromExprMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$read, readMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$fromRope, fromRopeMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$toRope, toRopeMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$paren, parenMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$zero, zeroMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$one, oneMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$sum, sumMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$negation, negationMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$difference, differenceMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$product, productMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$pow, powerMethod, ASExprClass]; AlgebraClasses.AddMethodToClass[$fraction, fractionMethod, ASExprClass]; <> <> END.