ExpressionsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
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;
Types
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;
Structure Operations
PrintName: PUBLIC AC.PrintNameProc = {
RETURN["MeddleExprs"];
};
ShortPrintName: PUBLIC AC.PrintNameProc = {
RETURN["MExprs"];
};
IsExprs: PUBLIC AC.UnaryPredicate = {
RETURN[AC.StructureEqual[arg, MeddleExprs] ];
};
I/O and Conversion
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] ]
};
Arithmetic
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] ];
};
Comparison
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];
Recursively check for equality of arguments
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];
Recursively evaluate arguments, find LUB of element Structures
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;
};
Standard Desired Arg Structures
MeddleExprsDesired: PUBLIC AC.UnaryToListOp ~ {
Name MeddleExprs explicitly, instead of using AC.DefaultDesiredArgStructures, so that if a MeddleExprs method found by lookup from a subclasss, then will recast its args correctly (i.e. to MeddleExprs)
RETURN[ LIST[MeddleExprs] ];
};
Start Code
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];
AC.InstallStructure[MeddleExprs]; -- do it later so methods from other structures found first (currently done in EvaluatorImpl)
END.