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.


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

Types
Element Representation
Given our assumption of one or more EltToEXPR procs in all domains (see below), allowing arbitrary Objects as subExprs, rather than limiting to Exprs, is essentially just being flexible with regard to the amount of local type inference that has been done on subExprs of an Expr.  E.g. if we required subExprs to be Exprs, a user could of course at any time select a subExpr and EltEval (type narrow) it, and indeed he may be imagining in his mind that this has in fact been done for a subExpr of interest.  And, of course, application of a EltToEXPR proc can always undo the casting of any subObject as an element of a (narrower) domain.  Hence it is appropriate to have a data representation that supports easily going back and forth between the two viewpoints.
Since we can have Expr Objects which are just an "outermost method" applied to Objects belonging to narrower domains, plus the assertion of membership of the whole in the Exprs domain, we make think of Exprs objecthood as a kind of "packaging", or "brush stroke", of collections of (other) Objects, that is tantamount to a declaration that we want to be relaxed, or insensitive, about the type of the total package.  And, with EltToEXPR procs, we have always the possibility of propagating this relaxedness to args.  And of course, by invoking eltEval$Exprs, we can always abrogate our relaxedness and try to limit the Object to a narrower domain. 
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 ASExprs explicitly, instead of using AlgebraClasses.DefaultDesiredArgStructures, so that if a ASExprs method found by lookup from a subclasss, then will recast its args correctly (i.e. to ASExprs)
Start Code
AlgebraClasses.AddMethodToClass[$eqFormula, equalMethod, ASExprClass]; -- commented 9/27/89, to allow entry of expression with variables to be later evaluated in some environment
AlgebraClasses.InstallStructure[ASExprs]; -- 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˜
head2šœ
œ
˜Jšœœ,˜<Jšœ˜J˜—Jšœœ
œ	˜
headš
Οn™Jš	œœ
œ
œœ
˜AKšœœœ
˜Kšœœ˜%Kšœœ˜%Kšœœœ
˜Kšœ
œ˜)Kšœ
œ˜#Kšœœ˜+Kšœœ˜'Kšœœ˜/Kšœ
œ˜)K˜Kšœœ˜%Kšœœ˜+Kšœœ˜'Kšœœ˜-Kšœœ˜3Kšœ
œ˜)Kšœœ˜/K˜Kšœ
œ˜#Kšœœ˜K˜—š
ž™šœœ˜šœ˜šœ˜˜KšœœΟcΔ
˜Ο
KšœœŸΥ˜βK˜—˜KšœœŸ˜Kšœœ
œ
œ
Ÿ˜&K˜
—Kš
˜—K˜K˜——šœœœŸ˜EK˜—Kš
œϊ™ϊKš
œˆ™ˆ—š
œ™šž	œœ!˜2Jšœ˜J˜J˜—šžœœ!˜7Jšœ˜J˜J˜—šžœœ"˜1Jšœ/˜5J˜——š
œ™šžœœ˜*JšœGœ˜kJš
œ˜J˜—šž	œœ"˜4Kšœ
œ˜
Jš
œ˜J˜—šžœœ˜*Jšœ
œ˜Jš
œ˜J˜—šžœœ˜.šœ
œ˜'Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Jš
œ˜J˜—šžœœ$˜:Kšœ
˜J˜J˜—šžœœ˜&Kšœ2˜8K˜K˜—šžœœ˜.Kš	œœ
œœ
œ˜Kšœ˜"K˜K˜—šžœœ˜*Kšœœ
˜#Kšœ ˜&K˜—K˜šžœœ˜(Jšœ˜ Jš
œ˜——š
ž
™
šžœœ˜)Jšœ5˜;Jš
œ˜J˜—šžœœ˜(Jšœ5˜;Jš
œ˜J˜—šžœœ˜'Kšœœ˜.Kšœœ˜0KšœF˜LK˜K˜—šžœœ˜)Kšœœ˜$Kšœžœ˜@K˜J˜—šžœœ˜,Kšœœ˜.Kšœœ˜0Kšœžœ$˜SK˜J˜—šžœœ˜,Kšœœ˜.Kšœœ˜0Kšœžœ$˜PK˜J˜—šžœœŸ1˜[Kšœœ˜.Kšœœ˜0Kšœžœ$˜LK˜J˜—šžœœ˜*Kšœœ˜.Kšœœ˜0Kšœžœ$˜QK˜——š
œ
™
šžœœ#˜0Kšœœœ˜(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˜——™šžœœ!˜7Jš
œΙ
™Ι
Jšœœ˜J˜J˜——™
Jš
žœœ$žœœœ˜OJš
žœœ(žœžœœ˜SJ˜Jšœ:œœ"œ˜wJšœAœœœ˜eJšœEœœœ˜mJšœCœœ,œ˜
Jšœ;œœ$œ˜wJšœEœœ.œ˜Ž
Jšœ;œœ$œ;˜§
Jšœ?œœ(œ˜‚
JšœKœœ4œ˜ 
Jšœ7œœ œ
˜nJšœ?œœ(œ˜
Jšœ;œœ$œ˜xJšœ9œœ0œ˜
Jšœ:œœ#œ
˜tJšœ9œœ"œ	˜qJšœ8œœ!œ8˜
Jšœ<œœ#œ=˜¨
Jšœ?œœ&œ?˜°
Jšœ<œœ&œ<˜ͺ
Jšœ:œœ#œ:˜£
Jšœ=œœ$œ=˜ͺ
JšœAœœ*œ;˜²
J˜Jš
œH˜HJš
œO˜OJš
œ^˜^Jš
œT˜TJš
œD˜DJš
œJ˜JJš
œD˜DJš
œH˜HJš
œT˜TJš
œ@˜@Jš
œH˜HJš
œD˜DJš
œB˜BJš
œ@˜@Jš
œ>˜>Jš
œ>˜>Jš
œH˜HJš
œL˜LJš
œF˜FJš
œ@˜@Jš
œH˜HJš
œ²
™²
J˜Jšœ žœa™ˆ
J˜J˜—˜J˜—Jšœ
˜J˜J˜—…—*l=φ