RealsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
DIRECTORY
Rope,
IO,
Basics,
Atom,
Convert,
RealFns,
AlgebraClasses,
MathConstructors,
Bools,
Ints,
BigRats,
Reals;
RealsImpl: CEDAR PROGRAM
IMPORTS IO, Convert, RealFns, AlgebraClasses, MathConstructors, Ints, BigRats
EXPORTS Reals
= BEGIN OPEN Reals, Convert, AC: AlgebraClasses;
Types
RealsError: PUBLIC SIGNAL [reason: ATOM ← $Unspecified] = CODE;
bitsPerWord: CARDINAL = Basics.bitsPerWord;
CARD: TYPE = LONG CARDINAL;
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Object: TYPE = AC.Object;
Method: TYPE = AC.Method;
Structure Operations
PrintName: PUBLIC AC.ToRopeOp = {
RETURN["Reals"];
};
ShortPrintName: PUBLIC AC.ToRopeOp = {
RETURN["R"];
};
Characteristic: PUBLIC AC.StructureRankOp = {
RETURN[ 0 ]
};
I/O and Conversion
Recast: PUBLIC AC.BinaryOp = {
args are a StructureElement and a Structure
IF AC.StructureEqual[firstArg.class, Reals] THEN RETURN[firstArg];
IF BigRats.CanRecast[firstArg, BigRats.BigRats] THEN
RETURN[ FromREAL[BigRats.ToReal[BigRats.Recast[firstArg, BigRats.BigRats] ] ] ];
RETURN[NIL];
};
CanRecast: PUBLIC AC.BinaryPredicate = {
firstArgStructure: Object ← IF firstArg.flavor = StructureElement THEN firstArg.class ELSE IF firstArg.flavor = Structure THEN firstArg ELSE ERROR;
SELECT TRUE FROM
AC.StructureEqual[firstArgStructure, Reals] => RETURN[TRUE];
BigRats.CanRecast[firstArg, BigRats.BigRats] => RETURN[TRUE];
ENDCASE;
RETURN[FALSE];
};
LegalFirstChar: PUBLIC AC.LegalFirstCharOp = {
SELECT char FROM
= '., IN ['0..'9] => RETURN[TRUE];
ENDCASE;
RETURN[BigRats.LegalFirstChar[char, structure] ];
};
Read: PUBLIC AC.ReadOp ~ {
real: REAL ← IO.GetReal[in ! IO.EndOfStream, IO.Error => GO TO TryRat ];
RETURN[FromREAL[real] ];
EXITS
TryRat => {
in.SetIndex[0];
RETURN[Recast[ BigRats.Read[in, BigRats.BigRats], Reals] ] };
};
Read: PUBLIC AC.ReadOp ~ {
rat: Object ← BigRats.Read[in, structure ! IO.Error => GO TO TryReal ];
RETURN[Recast[rat, Reals] ];
EXITS
TryReal => {
in.SetIndex[0];
RETURN[FromREAL[IO.GetReal[in] ] ] };
};
FromRope: PUBLIC AC.FromRopeOp = {
stream: IO.STREAM ← IO.RIS[in];
RETURN[ Read[stream, structure] ];
};
ToRope: PUBLIC AC.ToRopeOp = {
data: RealData ← NARROW[in.data];
RETURN[ Convert.RopeFromReal[data^] ];
};
Write: PUBLIC AC.WriteOp = {
IO.PutRope[ stream, ToRope[in] ]
};
ToExpr: PUBLIC AC.ToExprOp = {
data: RealData ← NARROW[in.data];
RETURN[MathConstructors.MakeReal[ data^] ];
};
FromREAL: PUBLIC PROC [real: REAL] RETURNS [Real] = {
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← real]
] ] ];
};
ToREAL: PUBLIC PROC [real: Real] RETURNS [REAL] = {
data: RealData ← NARROW[real.data];
RETURN[data^];
};
Arithmetic
Zero: PUBLIC AC.NullaryOp = {
RETURN[ RealZero ]
};
One: PUBLIC AC.NullaryOp = {
RETURN[ RealOne ]
};
Add: PUBLIC AC.BinaryOp ~ {
firstData: RealData ← NARROW[firstArg.data];
secondData: RealData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← firstData^ + secondData^ ]
] ] ];
};
Negate: PUBLIC AC.UnaryOp ~ {
data: RealData ← NARROW[arg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← - data^ ]
] ] ];
};
Subtract: PUBLIC AC.BinaryOp ~ {
firstData: RealData ← NARROW[firstArg.data];
secondData: RealData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← firstData^ - secondData^ ]
] ] ];
};
Multiply: PUBLIC AC.BinaryOp ~ {
firstData: RealData ← NARROW[firstArg.data];
secondData: RealData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← firstData^ * secondData^ ]
] ] ];
};
ObjectAndIntDesired: PUBLIC AC.UnaryToListOp ~ {
RETURN[ LIST[arg, Ints.Ints] ]; -- arg assumed to be a Structure
};
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;
};
Invert: PUBLIC AC.UnaryOp ~ {
data: RealData ← NARROW[arg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← 1.0 / data^ ]
] ] ];
};
Divide: PUBLIC AC.BinaryOp ~ {
firstData: RealData ← NARROW[firstArg.data];
secondData: RealData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← firstData^ / secondData^ ]
] ] ];
};
RealFns - Exponent and logarithm functions
Exp: PUBLIC AC.UnaryOp ~ {
firstData: RealData ← NARROW[arg.data];
RETURN[FromREAL[RealFns.Exp[ToREAL[arg] ] ] ];
};
Ln: PUBLIC AC.UnaryOp ~ {
firstData: RealData ← NARROW[arg.data];
RETURN[FromREAL[RealFns.Ln[ToREAL[arg] ] ] ];
};
SqRt: PUBLIC AC.UnaryOp ~ {
firstData: RealData ← NARROW[arg.data];
RETURN[FromREAL[RealFns.SqRt[ToREAL[arg] ] ] ];
};
RealFns - Trigonometric functions
Sin: PUBLIC AC.UnaryOp ~ {
firstData: RealData ← NARROW[arg.data];
RETURN[FromREAL[RealFns.Sin[ToREAL[arg] ] ] ];
};
Cos: PUBLIC AC.UnaryOp ~ {
firstData: RealData ← NARROW[arg.data];
RETURN[FromREAL[RealFns.Cos[ToREAL[arg] ] ] ];
};
Tan: PUBLIC AC.UnaryOp ~ {
firstData: RealData ← NARROW[arg.data];
RETURN[FromREAL[RealFns.Tan[ToREAL[arg] ] ] ];
};
Comparison
Sign: PUBLIC AC.CompareToZeroOp = {
data: RealData ← NARROW[arg.data];
SELECT data^ FROM
< 0.0 => RETURN[less];
= 0.0 => RETURN[equal];
ENDCASE => RETURN[greater];
};
Abs: PUBLIC AC.UnaryOp ~ {
data: RealData ← NARROW[arg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Reals,
flavor: StructureElement,
data: NEW[REAL ← ABS[data^] ]
] ] ];
};
Compare: PUBLIC AC.BinaryCompareOp ~ {
firstData: RealData ← NARROW[firstArg.data];
secondData: RealData ← NARROW[secondArg.data];
SELECT firstData^ FROM
< secondData^ => RETURN[less];
= secondData^ => RETURN[equal];
ENDCASE => RETURN[greater];
};
Equal: PUBLIC AC.BinaryPredicate ~ {
firstData: RealData ← NARROW[firstArg.data];
secondData: RealData ← NARROW[secondArg.data];
RETURN[ firstData^ = secondData^]
};
Standard Desired Arg Structures
RealsDesired: PUBLIC AC.UnaryToListOp ~ {
Name Reals explicitly, instead of using AC.DefaultDesiredArgStructures, so that if a Reals method found by lookup from a subclasss, then will recast its args correctly (i.e. to Reals)
RETURN[ LIST[Reals] ];
};
Start Code
RealClass: AC.StructureClass ← NEW[AC.StructureClassRec ← [
category: field,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
structureEqual: AC.defaultStructureEqualityTest,
characteristic: ClassCharacteristic,
isElementOf: AC.defaultElementOfProc,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
write: Write,
toExpr: ClassToExpr,
add: Add,
negate: Negate,
subtract: Subtract,
zero: ClassZero,
multiply: Multiply,
commutative: TRUE,
invert: Invert,
divide: Divide,
one: ClassOne,
equal: Equal,
ordered: TRUE,
sign: Sign,
abs: Abs,
compare: Compare,
completeField: TRUE,
realField: TRUE,
realClosedField: TRUE,
algebraicallyClosedField: FALSE,
propList: NIL
] ];
Reals: PUBLIC AC.Structure ← NEW[AC.StructureRec ← [
class: RealClass,
instanceData: NIL
] ];
RealClass: Object ← AC.MakeClass["RealClass", NIL, NIL];
Reals: PUBLIC Object ← AC.MakeStructure["Reals", RealClass, NIL];
RealOne: Real ← FromREAL[1.0]; -- do after Reals set
RealZero: Real ← FromREAL[0.0];
categoryMethod: Method ← AC.MakeMethod[Value, FALSE, NEW[AC.Category ← field], NIL, "category"];
groundStructureMethod: Method ← AC.MakeMethod[Value, FALSE, NIL, NIL, "groundStructure"];
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"];
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"];
toExprMethod: Method ← AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp ← ToExpr], NEW[AC.UnaryToListOp ← RealsDesired], "toExpr"];
realMethod: Method ← AC.MakeMethod[FromRopeOp, FALSE, NEW[AC.FromRopeOp ← FromRope], NIL, "real"];
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 ← RealsDesired], "sum"];
negationMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Negate], NEW[AC.UnaryToListOp ← RealsDesired], "negation"];
differenceMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Subtract], NEW[AC.UnaryToListOp ← RealsDesired], "difference"];
productMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Multiply], NEW[AC.UnaryToListOp ← RealsDesired], "product"];
commutativeMethod: Method ← AC.MakeMethod[Value, FALSE, NIL, NIL, "commutative"];
powerMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Power], NEW[AC.UnaryToListOp ← ObjectAndIntDesired], "power"];
invertMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Invert], NEW[AC.UnaryToListOp ← RealsDesired], "invert"];
fractionMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Divide], NEW[AC.UnaryToListOp ← RealsDesired], "fraction"];
expMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Exp], NEW[AC.UnaryToListOp ← RealsDesired], "exp"];
lnMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Ln], NEW[AC.UnaryToListOp ← RealsDesired], "ln"];
sqRtMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← SqRt], NEW[AC.UnaryToListOp ← RealsDesired], "sqRt"];
sinMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Sin], NEW[AC.UnaryToListOp ← RealsDesired], "sin"];
cosMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Cos], NEW[AC.UnaryToListOp ← RealsDesired], "cos"];
tanMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Tan], NEW[AC.UnaryToListOp ← RealsDesired], "tan"];
equalMethod: Method ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← Equal], NEW[AC.UnaryToListOp ← RealsDesired], "equals"];
orderedMethod: Method ← AC.MakeMethod[Value, FALSE, NIL, NIL, "ordered"];
signMethod: Method ← AC.MakeMethod[CompareToZeroOp, TRUE, NEW[AC.CompareToZeroOp ← Sign], NEW[AC.UnaryToListOp ← RealsDesired], "sign"];
absMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Abs], NEW[AC.UnaryToListOp ← RealsDesired], "abs"];
compareMethod: Method ← AC.MakeMethod[BinaryCompareOp, TRUE, NEW[AC.BinaryCompareOp ← Compare], NEW[AC.UnaryToListOp ← RealsDesired], "compare"];
AC.AddMethodToClass[$category, categoryMethod, RealClass];
AC.AddMethodToClass[$groundStructure, categoryMethod, RealClass];
AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, RealClass];
AC.AddMethodToClass[$recast, recastMethod, RealClass];
AC.AddMethodToClass[$canRecast, canRecastMethod, RealClass];
AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, RealClass];
AC.AddMethodToClass[$read, readMethod, RealClass];
AC.AddMethodToClass[$fromRope, fromRopeMethod, RealClass];
AC.AddMethodToClass[$toRope, toRopeMethod, RealClass];
AC.AddMethodToClass[$toExpr, toExprMethod, RealClass];
AC.AddMethodToClass[$real, realMethod, RealClass];
AC.AddMethodToClass[$zero, zeroMethod, RealClass];
AC.AddMethodToClass[$one, oneMethod, RealClass];
AC.AddMethodToClass[$paren, parenMethod, RealClass];
AC.AddMethodToClass[$sum, sumMethod, RealClass];
AC.AddMethodToClass[$negation, negationMethod, RealClass];
AC.AddMethodToClass[$difference, differenceMethod, RealClass];
AC.AddMethodToClass[$product, productMethod, RealClass];
AC.AddMethodToClass[$invert, invertMethod, RealClass];
AC.AddMethodToClass[$pow, powerMethod, RealClass];
AC.AddMethodToClass[$commutative, commutativeMethod, RealClass];
AC.AddMethodToClass[$fraction, fractionMethod, RealClass];
AC.AddMethodToClass[$exp, expMethod, RealClass];
AC.AddMethodToClass[$ln, lnMethod, RealClass];
AC.AddMethodToClass[$radical, sqRtMethod, RealClass];
AC.AddMethodToClass[$sin, sinMethod, RealClass];
AC.AddMethodToClass[$cos, cosMethod, RealClass];
AC.AddMethodToClass[$tan, tanMethod, RealClass];
AC.AddMethodToClass[$eqFormula, equalMethod, RealClass];
AC.AddMethodToClass[$ordered, orderedMethod, RealClass];
AC.AddMethodToClass[$sign, signMethod, RealClass];
AC.AddMethodToClass[$abs, absMethod, RealClass];
AC.AddMethodToClass[$compare, compareMethod, RealClass];
AC.InstallStructure[Reals];
AC.SetSuperClass[BigRats.BigRats, Reals];
END.