BoolsImpl.mesa
Last Edited by: Arnon, July 19, 1985 2:54:46 pm PDT
DIRECTORY
Rope,
IO,
Basics,
Atom,
Convert,
AlgebraClasses,
MathConstructors,
Bools;
BoolsImpl: CEDAR PROGRAM
IMPORTS IO, Convert, AlgebraClasses, MathConstructors
EXPORTS Bools
= BEGIN OPEN Bools, Convert, AC: AlgebraClasses;
Types
BoolsError: 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;
TypeError: PUBLIC ERROR [message: ATOM ← $Unspecified] = CODE;
Variables
PrintName: AC.ToRopeOp = {
RETURN["Bools"];
};
ShortPrintName: AC.ToRopeOp = {
RETURN["B"];
};
LegalFirstChar: AC.LegalFirstCharOp = {
SELECT char FROM
'T, 'F => RETURN[TRUE];
ENDCASE;
RETURN[FALSE];
};
ToExpr: AC.ToExprOp = {
data: BoolData ← NARROW[in.data];
RETURN[MathConstructors.MakeBool[Convert.RopeFromBool[data^] ] ];
};
Recast: AC.BinaryOp = {
IF NOT AC.StructureEqual[firstArg.class, Bools] THEN RETURN[NIL] ELSE RETURN[firstArg];
};
CanRecast: 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, Bools] => RETURN[TRUE];
ENDCASE;
RETURN[FALSE];
};
I/O and Conversion
Read: PUBLIC AC.ReadOp ~ {
RETURN[NEW[AC.ObjectRec ← [
class: Bools,
flavor: StructureElement,
data: NEW[BOOL ← IO.GetBool[in] ]
] ] ];
};
FromRope: PUBLIC AC.FromRopeOp = {
stream: IO.STREAM ← IO.RIS[in];
RETURN[ Read[stream, structure] ];
};
ToRope: PUBLIC AC.ToRopeOp = {
data: BoolData ← NARROW[in.data];
RETURN[ Convert.RopeFromBool[data^] ];
};
Write: PUBLIC AC.WriteOp = {
IO.PutRope[ stream, ToRope[in] ]
};
FromBOOL: PUBLIC AC.FromBOOLOp = {
RETURN[NEW[AC.ObjectRec ← [
class: Bools,
flavor: StructureElement,
data: NEW[BOOL ← in]
] ] ];
};
ToBOOL: PUBLIC PROC [bool: Bool] RETURNS [BOOL] = {
data: BoolData ← NARROW[bool.data];
RETURN[data^];
};
Arithmetic
Equal: PUBLIC AC.BinaryPredicate ~ {
firstData: BoolData ← NARROW[firstArg.data];
secondData: BoolData ← NARROW[secondArg.data];
RETURN[ firstData^ = secondData^ ]
};
Disjunct: PUBLIC AC.BinaryOp ~ {
firstData: BoolData ← NARROW[firstArg.data];
secondData: BoolData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Bools,
flavor: StructureElement,
data: NEW[BOOL ← firstData^ OR secondData^ ]
] ] ];
};
Conjunct: PUBLIC AC.BinaryOp ~ {
firstData: BoolData ← NARROW[firstArg.data];
secondData: BoolData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Bools,
flavor: StructureElement,
data: NEW[BOOL ← firstData^ AND secondData^ ]
] ] ];
};
Negate: PUBLIC AC.UnaryOp ~ {
data: BoolData ← NARROW[arg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Bools,
flavor: StructureElement,
data: NEW[BOOL ← NOT data^ ]
] ] ];
};
Paren: PUBLIC AC.UnaryOp ~ {
RETURN[NEW[AC.ObjectRec ← [
flavor: StructureElement,
class: Bools,
data: arg.data
] ] ];
};
Difference: PUBLIC AC.BinaryOp ~ {
firstData: BoolData ← NARROW[firstArg.data];
secondData: BoolData ← NARROW[secondArg.data];
RETURN[NEW[AC.ObjectRec ← [
class: Bools,
flavor: StructureElement,
data: NEW[BOOL ← firstData^ AND NOT secondData^ ]
] ] ];
};
Start Code
BoolClass: AC.StructureClass ← NEW[AC.StructureClassRec ← [
category: lattice,
printName: ClassPrintName,
shortPrintName: ClassShortPrintName,
structureEqual: AC.defaultStructureEqualityTest,
isElementOf: AC.defaultElementOfProc,
legalFirstChar: ClassLegalFirstChar,
read: Read,
fromRope: FromRope,
toRope: ToRope,
write: Write,
toExpr: ClassToExpr,
add: Disjunct,
negate: Negate, -- hack,
multiply: Conjunct,
divide: Difference,
booleanAlgebra: TRUE,
complement: Negate,
equal: ClassEqual,
propList: NIL
] ];
Bools: PUBLIC AC.Structure ← NEW[AC.StructureRec ← [
class: BoolClass,
instanceData: NIL
] ];
BoolClass: Object ← AC.MakeClass["BoolClass", NIL, NIL];
Bools: PUBLIC Object ← AC.MakeStructure["Bools", BoolClass, NIL];
True: PUBLIC Object ← FromBOOL[TRUE];
False: PUBLIC Object ← FromBOOL[FALSE];
categoryMethod: Method ← AC.MakeMethod[Value, FALSE, NEW[AC.Category ← lattice], 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"];
toExprMethod: Method ← AC.MakeMethod[ToExprOp, FALSE, NEW[AC.ToExprOp ← ToExpr], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "toExpr"];
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"];
boolMethod: Method ← AC.MakeMethod[FromRopeOp, FALSE, NEW[AC.FromRopeOp ← FromRope], NIL, "bool"];
fromBOOLMethod: Method ← AC.MakeMethod[FromBOOLOp, FALSE, NEW[AC.FromBOOLOp ← FromBOOL], NIL, "fromBOOL"];
parenMethod: Method ← AC.MakeMethod[UnaryOp, FALSE, NEW[AC.UnaryOp ← Paren], NIL, "paren"];
orMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Disjunct], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "or"];
notMethod: Method ← AC.MakeMethod[UnaryOp, TRUE, NEW[AC.UnaryOp ← Negate], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "not"];
differenceMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Difference], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "difference"];
andMethod: Method ← AC.MakeMethod[BinaryOp, TRUE, NEW[AC.BinaryOp ← Conjunct], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "and"];
equalMethod: Method ← AC.MakeMethod[BinaryPredicate, TRUE, NEW[AC.BinaryPredicate ← Equal], NEW[AC.UnaryToListOp ← AC.DefaultDesiredArgStructures], "equals"];
AC.AddMethodToClass[$category, categoryMethod, BoolClass];
AC.AddMethodToClass[$groundStructure, categoryMethod, BoolClass];
AC.AddMethodToClass[$recast, recastMethod, BoolClass];
AC.AddMethodToClass[$shortPrintName, shortPrintNameMethod, BoolClass];
AC.AddMethodToClass[$canRecast, canRecastMethod, BoolClass];
AC.AddMethodToClass[$toExpr, toExprMethod, BoolClass];
AC.AddMethodToClass[$legalFirstChar, legalFirstCharMethod, BoolClass];
AC.AddMethodToClass[$read, readMethod, BoolClass];
AC.AddMethodToClass[$fromRope, fromRopeMethod, BoolClass];
AC.AddMethodToClass[$toRope, toRopeMethod, BoolClass];
AC.AddMethodToClass[$bool, boolMethod, BoolClass];
AC.AddMethodToClass[$fromBOOL, fromBOOLMethod, BoolClass];
AC.AddMethodToClass[$paren, parenMethod, BoolClass];
AC.AddMethodToClass[$or, orMethod, BoolClass];
AC.AddMethodToClass[$not, notMethod, BoolClass];
AC.AddMethodToClass[$difference, differenceMethod, BoolClass];
AC.AddMethodToClass[$and, andMethod, BoolClass];
AC.AddMethodToClass[$eqFormula, equalMethod, BoolClass];
AC.InstallStructure[Bools];
END.