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.


vExpressionsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT

Types
Structure Operations
I/O and Conversion
Arithmetic
Comparison
Recursively check for equality of arguments
Recursively evaluate arguments, find LUB of element Structures
Standard Desired Arg Structures
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)
Start Code
AC.InstallStructure[MeddleExprs]; -- do it later so methods from other structures found first  (currently done in EvaluatorImpl)
Κ˜Jš
œ™J™3J™š
Οk	˜	Jš
œ˜J˜Icode˜J˜	J˜J˜J˜Jš
œ˜—J˜
head2šœœ
˜Jšœœ2˜BJšœ˜J˜—Jšœœ
œ
œ˜-
headš
Οn™Jš	œœ
œ
œœ
˜EKšœœœ
˜Kšœœœ˜Kšœœœ˜Kšœœœ
˜Kšœ
œ˜)Kšœ
œ˜#Kšœœ˜+Kšœœ˜'Kšœœ˜/Kšœ
œ˜)K˜Kšœœ˜%Kšœœ˜+Kšœœ˜'Kšœœ˜-Kšœœ˜3Kšœ
œ˜)Kšœœ˜/K˜Kšœ
œ˜#Kšœœ˜K˜—š
œ™šž	œœ
œ˜&Jšœ˜J˜J˜—šžœœ
œ˜+Jšœ˜J˜J˜—šžœœ
œ˜%Jšœ
œ$˜-J˜——š
œ™šžœ	œ
˜Jšœ
œ/œ˜cJš
œ˜J˜—šž	œ	œ˜(Kšœ
œ˜
Jš
œ˜J˜—šžœœ
œ
˜Jšœ
œ˜Jš
œ˜J˜—šžœ	œ˜"šœ
œ
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Jš
œ˜J˜—šžœœ
œ˜.Kšœ
˜J˜J˜—šžœœ
œ˜Kšœ6˜<K˜K˜—šžœœ
œ˜"Kš	œœ
œœ
œ˜Kšœ˜"K˜K˜—šžœœ
œ
˜Kšœœ
˜'Kšœ ˜&K˜—K˜šžœœ
œ˜Jšœ˜ Jš
œ˜——š
ž
™
šžœ	œ˜Jšœ9˜?Jš
œ˜J˜—šžœ	œ˜Jšœ9˜?Jš
œ˜J˜—šžœœ
œ
˜Kšœœ˜2Kšœœ˜4KšœJ˜PK˜K˜—šžœœ
œ˜Kšœœ˜(Kšœžœ˜DK˜J˜—šžœœ
œ
˜ Kšœœ˜2Kšœœ˜4Kšœžœ(˜WK˜J˜—šžœœ
œ
˜ Kšœœ˜2Kšœœ˜4Kšœžœ(˜TK˜J˜—šžœœ
œΟc1˜OKšœœ˜#K˜#Kšœœ)œ˜KKšœœ.˜Hšœœ˜Kšœœ-˜FKš
œ
˜
Kšœœ
œ
œ
˜!Kšœ$œ˜3Kšœ
œ(œ˜@K˜—Kšœœ
œ˜Kš
œ˜šœœ
œ˜Kšœ	œ)œ˜MKšœ
˜—K˜J˜—šžœœ
œ
˜Kšœœ˜2Kšœœ˜4Kšœžœ(˜UK˜——š
œ
™
šžœœ
œ˜$Kšœœœ˜(Kšœœœ˜*Kšœ$˜*K˜K˜—š
ž	œœœœ
œ˜?šœœ
˜K˜˜K˜Jšœ
œ
œœ
œ
œœœ
˜RJšœœ
œ
œ˜2J˜Jš
œ
œœ
œ
œ˜7Jšœ
œ˜
K˜—K˜˜K˜Jšœ
œ
œœ
œ
œœœ
˜VJšœœ
œ
œ˜2K˜Kš
œ+™+šœœ
œ&œœ
˜DKš
œH˜HKš
œH˜HKš
œ
œœ
œ
œ˜0Kšœ
˜—Kšœ
œ˜
K˜—K˜˜K˜Kšœœ
œ˜K˜Jšœ
œ
œœ
œ
œœœ
˜TJšœœ
œ
œ˜2K˜Kš
œ>™>K˜šœœ
œ%œœ
˜CKš
œ
œ3œ
œ
œ˜LJš
œ˜Kšœ
˜—Kšœ
œ˜
K˜—K˜Kšœœ
˜—J˜——™šžœœ
œ˜/Jšœ.œ™
™Ι
Jšœœ˜J˜J˜——™
Jš
žœœžœœœ˜DJšžœœ
œžœžœœ˜SJ˜Jšœœœœ
œœ˜_Jš	œ œœœœ˜YJš	œ$œœœœ˜aJšœœœœ
œœ˜xJšœœœœ
œœ˜_Jšœœœœ
œœ˜vJš
œœœœ
œœ
œ0˜†
Jšœœœœ
œœ˜iJšœœœœ
œ%œ˜ˆ
Jšœœœœ
œœ
˜VJšœœœœ
œœ˜iJšœœœœ
œœ˜`Jš
œœœœ
œœœ˜]Jšœœœœ
œœ
˜\Jšœœœœ
œœ	˜YJš
œœœœ
œœ
œ-˜}Jš
œœœœ
œœ
œ2˜ˆ
Jš
œœœœ
œœ
œ4˜
Jš
œœœœ
œœ
œ1˜Š
Jš
œœœœ
œœ
œ/˜ƒ
Jš
œœœœ
œœ
œ2˜Š
Jš
œœœœ
œœ
œ0˜’
J˜Jšœ>˜@JšœE˜GJšœT˜VJšœJ˜LJšœ:˜<Jšœ@˜BJšœ:˜<Jšœ>˜@JšœJ˜LJšœ6˜8Jšœ>˜@Jšœ:˜<Jšœ8˜:Jšœ6˜8Jšœ4˜6Jšœ4˜6Jšœ>˜@JšœB˜DJšœ<˜>Jšœ6˜8Jšœ>˜@Jšœ<˜>J˜Jšœžœa™€
J˜J˜—˜J˜—Jšœ
˜J˜J˜—…—%Β4D