DIRECTORY  Core, Boole, CoreOps, CoreProperties, Rope, RopeList, TerminalIO;

BooleImpl: CEDAR PROGRAM
IMPORTS CoreOps, CoreProperties, Rope, RopeList, TerminalIO
EXPORTS Boole = 
BEGIN 
OPEN Boole;
coreBoolProcsProp: ATOM = CoreProperties.RegisterProperty[$CoreBoolProcs];
CoreBoolProcs: TYPE = REF CoreBoolProcsRec;
CoreBoolProcsRec: TYPE = RECORD [
eval: EvalProc,
toRope: ToRopeProc,
findVar: FindVarProc];
constantClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "BooleConstant"]];
ConstantData: TYPE = REF ConstantDataRec;
ConstantDataRec: TYPE = RECORD [value: BOOL];
alpsClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "BooleAlps"]];
AlpsData: TYPE = REF AlpsDataRec;
AlpsDataRec: TYPE = RECORD [var: ROPE, thenExpr, elseExpr: Expression];
notClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "BooleNot"]];
true: PUBLIC Expression _ CoreOps.CreateCellType[class: constantClass, public: CoreOps.CreateWires[0], data: NEW [ConstantDataRec _ [TRUE]], name: "True"];
false: PUBLIC Expression _ CoreOps.CreateCellType[class: constantClass, public: CoreOps.CreateWires[0], data: NEW [ConstantDataRec _ [FALSE]], name: "False"];
Op2Proc: TYPE = PROC [expr1, expr2: Expression] RETURNS [result: Expression];

And2: Op2Proc = {
result _ SELECT TRUE FROM
expr1=false	=> false,
expr2=false	=> false,
expr1=true	=> expr2,
expr2=true	=> expr1,
ENDCASE	=> Op2[And2, expr1, expr2];
};

Or2: Op2Proc = {
result _ SELECT TRUE FROM
expr1=false	=> expr2,
expr2=false	=> expr1,
expr1=true	=> true,
expr2=true	=> true,
ENDCASE	=> Op2[Or2, expr1, expr2];
};

Xor2: Op2Proc = {
result _ SELECT TRUE FROM
expr1=false	=> expr2,
expr2=false	=> expr1,
expr1=true	=> Not[expr2],
expr2=true	=> Not[expr1],
ENDCASE	=> Op2[Xor2, expr1, expr2];
};

Op2: PROC [op: Op2Proc, expr1, expr2: Expression] RETURNS [result: Expression] = {
var: ROPE _ FindVar[expr1];
expr1True, expr1False, expr2True, expr2False: Expression;
IF var=NIL THEN ERROR;
[expr1True, expr1False] _ Eval[var, expr1];
[expr2True, expr2False] _ Eval[var, expr2];
result _ CreateAlps[var, op[expr1True, expr2True], op[expr1False, expr2False]];
};

CreateAlps: PROC [var: ROPE, thenExpr, elseExpr: Expression] RETURNS [result: Expression] = {
UnionWire: PROC [wire: Core.Wire] = {
FOR i: NAT IN [0 .. wire.size) DO
subwire: Core.Wire _ wire[i];
subName: ROPE _ CoreOps.GetShortWireName[subwire];
IF subName=NIL OR subwire.size#0 THEN {
TerminalIO.WriteF["Incorrect wire structure or wire name\n"]; -- subwire
ERROR;
};
IF ~RopeList.Memb[lropes, subName] THEN lropes _ CONS [subName, lropes];
ENDLOOP;
};

lropes: LIST OF ROPE _ LIST [var];
IF FindVarInExpr[var, thenExpr] OR FindVarInExpr[var, elseExpr] THEN {
TerminalIO.WriteF["Incorrect Alps formation\n"]; -- var
ERROR;
};
IF Equal[thenExpr, elseExpr] THEN RETURN [thenExpr];
UnionWire[thenExpr.public]; UnionWire[elseExpr.public];
result _ CoreOps.CreateCellType[
class: alpsClass, 
public: WireFromRopes[lropes], 
data: NEW [AlpsDataRec _ [var: var, thenExpr: thenExpr, elseExpr: elseExpr]]
];
};
Var: PUBLIC PROC [var: ROPE] RETURNS [result: Expression] = {
result _ CreateAlps[var, true, false];
};

Not: PUBLIC PROC [expr: Expression] RETURNS [result: Expression] = {
result _ SELECT TRUE FROM
expr=true 		=> false,
expr=false 		=> true,
expr.class=notClass	=> NARROW [expr.data],
ENDCASE 		=> CoreOps.CreateCellType[class: notClass, data: expr, public: CoreOps.CopyWire[expr.public]];
};

And: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ true] RETURNS [result: Expression] = {
result _ AndList[LIST [expr1, expr2, expr3, expr4, expr5]];
};
Or: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ false] RETURNS [result: Expression] = {
result _ OrList[LIST [expr1, expr2, expr3, expr4, expr5]];
};
Xor: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ false] RETURNS [result: Expression] = {
result _ XorList[LIST [expr1, expr2, expr3, expr4, expr5]];
};
Nand: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ true] RETURNS [result: Expression] = {
result _ NandList[LIST [expr1, expr2, expr3, expr4, expr5]];
};
Nor: PUBLIC PROC [expr1, expr2, expr3, expr4, expr5: Expression _ false] RETURNS [result: Expression] = {
result _ NorList[LIST [expr1, expr2, expr3, expr4, expr5]];
};

AndList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = {
result _ true;
WHILE exprs#NIL DO result _ And2[result, exprs.first]; exprs _ exprs.rest ENDLOOP;
};
OrList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = {
result _ false;
WHILE exprs#NIL DO result _ Or2[result, exprs.first]; exprs _ exprs.rest ENDLOOP;
};
XorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = {
result _ false;
WHILE exprs#NIL DO result _ Xor2[result, exprs.first]; exprs _ exprs.rest ENDLOOP;
};
NandList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = {
result _ Not[AndList[exprs]];
};
NorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [result: Expression] = {
result _ Not[OrList[exprs]];
};

If: PUBLIC PROC [cond, then, else: Expression] RETURNS [result: Expression] = {
IF Equal[then, else] THEN RETURN [then];
result _ Or2[And2[cond, then], And2[Not[cond], else]];
};
AlpsEval: EvalProc = {
alpsData: AlpsData _ NARROW [expr.data];
thenExprTrue, thenExprFalse, elseExprTrue, elseExprFalse: Expression;
IF Rope.Equal[alpsData.var, var] THEN RETURN [alpsData.thenExpr, alpsData.elseExpr];
[thenExprTrue, thenExprFalse] _ Eval[var, alpsData.thenExpr];
[elseExprTrue, elseExprFalse] _ Eval[var, alpsData.elseExpr];
whenTrue _ CreateAlps[alpsData.var, thenExprTrue, elseExprTrue];
whenFalse _ CreateAlps[alpsData.var, thenExprFalse, elseExprFalse];
};

NotEval: EvalProc = {
notData: Expression _ NARROW [expr.data];
[whenTrue, whenFalse] _ Eval[var, notData];
whenTrue _ Not[whenTrue]; whenFalse _ Not[whenFalse];
};
ConstantToRope: ToRopeProc = {
constantData: ConstantData _ NARROW [expr.data];
RETURN [IF constantData.value THEN "1" ELSE "0"];
};

AlpsToRope: ToRopeProc = {
alpsData: AlpsData _ NARROW [expr.data];
case: ATOM _ Case[alpsData.thenExpr, alpsData.elseExpr];
SELECT case FROM
$Case10			=> RETURN [alpsData.var];
$Case01			=> RETURN [Rope.Cat["Not[", alpsData.var, "]"]];
$Case1X, $Case0X, $CaseX1, $CaseX0, $CaseXY	=> RETURN [Rope.Cat[
Rope.Cat["If[", alpsData.var, ", "], 
ToRope[alpsData.thenExpr, deep-1],
", ", 
ToRope[alpsData.elseExpr, deep-1],
"]"]];
ENDCASE			=> ERROR;
};

NotToRope: ToRopeProc = {
notData: Expression _ NARROW [expr.data];
RETURN [Rope.Cat["Not[", ToRope[notData, deep-1], "]"]];
};
ConstantFindVar: FindVarProc = {RETURN [NIL]};

AlpsFindVar: FindVarProc = {
alpsData: AlpsData _ NARROW [expr.data];
RETURN [alpsData.var];
};

NotFindVar: FindVarProc = {
notData: Expression _ NARROW [expr.data];
RETURN [FindVar[notData]];
};
Eval: PUBLIC EvalProc = {
procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]];
IF ~FindVarInExpr[var, expr] THEN RETURN [expr, expr];
[whenTrue, whenFalse] _ procs.eval[var, expr];
};

ToRope: PUBLIC ToRopeProc = {
procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]];
IF deep<0 THEN RETURN[" ... "];
RETURN [procs.toRope[expr, deep]];
};

FromRope: PUBLIC PROC [er: ROPE] RETURNS [expr: Expression] = {
RecurseFromRope: PROC RETURNS [e: Expression] = {
SELECT Rope.Fetch[er, p] FROM
'0 => {p _ p + 1; e _ false};
'1 => {p _ p + 1; e _ true};
'N => IF Rope.Fetch[er, p+1]='o AND Rope.Fetch[er, p+2]='t AND Rope.Fetch[er, p+3]='[ THEN {
p _ p + 4;
e _ Not[RecurseFromRope[]];
IF Rope.Fetch[er, p]#'] THEN ERROR;
p _ p + 1;
};
'I => IF Rope.Fetch[er, p+1]='f AND Rope.Fetch[er, p+2]='[ THEN {
cond, then, else: Expression _ NIL;
p _ p + 3;
cond _ RecurseFromRope[];
IF Rope.Fetch[er, p]#', OR Rope.Fetch[er, p+1]#'  THEN ERROR;
p _ p + 2;
then _ RecurseFromRope[];
IF Rope.Fetch[er, p]#', OR Rope.Fetch[er, p+1]#'  THEN ERROR;
p _ p + 2;
else _ RecurseFromRope[];
IF Rope.Fetch[er, p]#'] THEN ERROR;
p _ p + 1;
e _ If[cond, then, else];
};
ENDCASE => {
start: INT _ p;
brackets: INT _ 0;
WHILE Rope.Fetch[er, p]#', AND NOT (Rope.Fetch[er, p]='] AND brackets=0) DO
IF Rope.Fetch[er, p]='[ THEN brackets _ brackets + 1;
IF Rope.Fetch[er, p]='] THEN brackets _ brackets - 1;
p _ p + 1;
IF p>= size THEN EXIT;
ENDLOOP;
e _ Var[Rope.Substr[er, start, p-start]];
};
};
p: INT _ 0;
size: INT _ Rope.Length[er];
expr _ RecurseFromRope[];
};

FindVar: PUBLIC FindVarProc = {
procs: CoreBoolProcs _ NARROW [CoreProperties.GetProp[expr.class.properties, coreBoolProcsProp]];
var _ procs.findVar[expr];
};

Equal: PUBLIC PROC [expr1, expr2: Expression] RETURNS [BOOL] = {
neg: BOOL _ TRUE;
IF expr1=expr2 THEN RETURN [TRUE];
IF expr1.class=notClass THEN {neg _ ~neg; expr1 _ Not[expr1]};
IF expr2.class=notClass THEN {neg _ ~neg; expr2 _ Not[expr2]};
IF expr1.class=constantClass AND expr2.class=constantClass THEN RETURN [(expr1=expr2)=neg];
IF expr1.class=constantClass OR expr2.class=constantClass THEN RETURN [FALSE];
IF expr1.class#alpsClass OR expr2.class#alpsClass THEN ERROR;
IF ~FindVarInExpr[FindVar[expr1], expr2] THEN RETURN [FALSE];
IF ~FindVarInExpr[FindVar[expr2], expr1] THEN RETURN [FALSE];
BEGIN
var: ROPE _ FindVar[expr1];
expr1True, expr1False, expr2True, expr2False: Expression;
IF var=NIL THEN ERROR; -- expr1 has no Wire
[expr1True, expr1False] _ Eval[var, expr1];
[expr2True, expr2False] _ Eval[var, expr2];
IF NOT neg THEN {expr2True _ Not[expr2True]; expr2False _ Not[expr2False]};
RETURN [Equal[expr1True, expr2True] AND Equal[expr1False, expr2False]]
END;
};
WireFromRopes: PROC [lropes: LIST OF ROPE] RETURNS [wire: Core.Wire] = {
size: NAT _ RopeList.Length[lropes];
wire _ CoreOps.CreateWires[size: size];
FOR i: NAT IN [0 .. size) DO 
wire[i] _ CoreOps.CreateWire[name: lropes.first]; lropes _ lropes.rest; 
ENDLOOP;
};

FindVarInExpr: PROC [var: ROPE, expr: Expression] RETURNS [found: BOOL _ FALSE] = {
public: Core.Wire _ expr.public;
FOR i: NAT IN [0 .. public.size) DO 
IF Rope.Equal[var, CoreOps.GetShortWireName[public[i]]] THEN RETURN [TRUE];
ENDLOOP;
};
Case: PUBLIC PROC [whenTrue, whenFalse: Expression] RETURNS [case: ATOM] = {
case _ SELECT TRUE FROM
Equal[whenTrue, true] AND Equal[whenFalse, true]		=> $Case11,
Equal[whenTrue, false] AND Equal[whenFalse, false]		=> $Case00,
Equal[whenTrue, true] AND Equal[whenFalse, false]		=> $Case10,
Equal[whenTrue, false] AND Equal[whenFalse, true]		=> $Case01,
Equal[whenTrue, true] 										=> $Case1X,		
Equal[whenTrue, false] 										=> $Case0X,		
Equal[whenFalse, true] 										=> $CaseX1,		
Equal[whenFalse, false] 										=> $CaseX0,
Equal[whenTrue, whenFalse] 								=> $CaseXX,
ENDCASE															=> $CaseXY;
};
CoreProperties.PutCellClassProp[constantClass, coreBoolProcsProp, NEW [CoreBoolProcsRec _ [toRope: ConstantToRope, findVar: ConstantFindVar]]];
CoreProperties.PutCellClassProp[alpsClass, coreBoolProcsProp, NEW [CoreBoolProcsRec _ [eval: AlpsEval, toRope: AlpsToRope, findVar: AlpsFindVar]]];
CoreProperties.PutCellClassProp[notClass, coreBoolProcsProp, NEW [CoreBoolProcsRec _ [eval: NotEval, toRope: NotToRope, findVar: NotFindVar]]];

END.
 
BooleImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reversed.
Created by Bertrand Serlet July 31, 1985 3:03:17 pm PDT
Bertrand Serlet May 7, 1986 9:56:28 pm PDT
Louis Monier June 3, 1986 7:28:32 pm PDT
Barth, May 22, 1986 5:42:30 pm PDT

Types and Utilities
Properties on classes known by CoreBool hang on atom coreBoolProcsProp.  they are of type CoreBoolProcs.
Expression Classes
Constants

Alps
The invariant is that none of thenExpr and elseExpr contains variable var.  The order of variables in thenExpr and elseExpr might be different

Negation
data field of the CellType contains the Expression being negated.
Constants
Binary Operators 
It is assumed that none of expr1 and expr2 are constants
Operators returning Expressions
Private EvalProcs
Private ToRopeProcs
Private FindVarProcs
Public operations
Private operations
Can only be used as an hint: if var is present, this does not imply that this variable is really significant
Private operations that depend on the representation
Initialization
Κ{–

"cedar" style˜
codeš
œ™Jšœ
Οm
œ1™<J™7J™*K™(K™"K™—KšΟk	œC˜LJ˜•StartOfExpansion[]šΟn	œžœ
ž˜Kšžœ4˜;Kšžœ	˜Kšžœ
˜Kšžœ˜—
head™šœžœ3˜JKš
œh™h—Kšœžœžœ˜+šœžœžœ˜!Kš
œ˜Kš
œ˜Kš
œ˜——™™	Kšœ žœ/˜RKšœžœžœ˜)Kšœžœžœ	žœ˜-—K™™Kšœžœ+˜JKšœ
žœžœ
˜!šœ
žœžœžœ"˜GKš
œŽ
™Ž
——K™™Kšœžœ*˜HJ™A——™	Jšœžœažœžœ˜›
Jšœžœažœžœ˜ž
—š
œ™K–I -- [design: Core.Design, me: Core.CellType] RETURNS [new: Core.CellType]šœ	žœžœžœ˜MK˜šΠbnœ
˜šœ	žœ
žœ
ž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœ˜#—K˜—K–I -- [design: Core.Design, me: Core.CellType] RETURNS [new: Core.CellType]˜–I -- [design: Core.Design, me: Core.CellType] RETURNS [new: Core.CellType]š œ
˜šœ	žœ
žœ
ž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœ˜"—K˜—K˜–I -- [design: Core.Design, me: Core.CellType] RETURNS [new: Core.CellType]š œ
˜šœ	žœ
žœ
ž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœ˜#—K˜—K˜šŸœžœ)žœ˜RKš
œ8™8Kšœžœ˜Jš
œ9˜9Jšžœžœ
žœ
žœ
˜Jš
œ+˜+Jš
œ+˜+Jš
œO˜OK˜—K˜šŸ
œžœžœ"žœ˜]šŸ	œžœ˜%šžœžœ
žœž˜!Kš
œ˜Kšœ	žœ%˜2šžœ	žœ
žœžœ˜'Kšœ>Οc
˜HKšžœ
˜K˜—Kšžœ!žœ
žœ˜HKšžœ
˜—K˜—K˜Kš	œžœ
žœ
žœžœ˜"šžœžœžœ˜FKšœ1‘˜7Kšžœ
˜K˜—Kšžœžœ
žœ˜4Kš
œ7˜7š
œ ˜ Jš
œ˜Jš
œ˜JšœžœC˜LJš
œ˜—K˜——š
œ™š
Ÿœžœ
žœžœžœ˜=Kš
œ&˜&K˜—K˜šŸœžœ
žœžœ˜Dšœ	žœ
žœ
ž˜K˜K˜Kšœžœ
˜*Kšžœa˜h—K˜—K˜š œžœ
žœ8žœ˜hKšœžœ&˜;Kš
œ˜—šŸœžœ
žœ9žœ˜hKšœžœ&˜:Kš
œ˜—šŸœžœ
žœ9žœ˜iKšœžœ&˜;Kš
œ˜—šŸœžœ
žœ8žœ˜iKšœžœ&˜<Kš
œ˜—šŸœžœ
žœ9žœ˜iKšœžœ&˜;Kš
œ˜—K˜šŸœžœ
žœ	žœ
žœ
žœ˜QKš
œ˜Kšžœžœ
žœ8žœ
˜RK˜—šŸœžœ
žœ	žœ
žœ
žœ˜PKš
œ˜Kšžœžœ
žœ7žœ
˜QK˜—šŸœžœ
žœ	žœ
žœ
žœ˜QKš
œ˜Kšžœžœ
žœ8žœ
˜RK˜—šŸœžœ
žœ	žœ
žœ
žœ˜RKš
œ˜K˜—šŸœžœ
žœ	žœ
žœ
žœ˜QKš
œ˜K˜—K˜šŸœžœ
žœ žœ˜OKšžœžœ
žœ˜(Kš
œ6˜6K˜——™š œ˜Jšœžœ
˜(Kš
œE˜EKšžœžœ
žœ(˜TKš
œ=˜=Kš
œ=˜=Kš
œ@˜@Kš
œC˜CK˜—K˜š œ˜Jšœžœ
˜)Jš
œ+˜+Kš
œ5˜5Kš
œ˜——™š œ˜Jšœžœ
˜0Jšžœžœžœžœ˜1K˜K˜—š 
œ˜Jšœžœ
˜(Kšœžœ.˜8šžœž˜Kšœ
žœ˜#Kšœ
žœ'˜:šœ/žœ˜@Kš
œ%˜%Kš
œ"˜"K˜Kš
œ"˜"Kš
œ˜—Kšžœžœ
˜—K˜—K˜š 	œ˜Jšœžœ
˜)Kšžœ2˜8Kš
œ˜——™Kš Ÿœžœžœ˜.K˜š Ÿœ˜Jšœžœ
˜(Kšžœ˜K˜—K˜š Ÿ 
œ˜Jšœžœ
˜)Kšžœ˜Kš
œ˜——™š œžœ
˜KšœžœD˜aKšžœžœ
žœ˜6Jš
œ.˜.K˜—K˜š œžœ˜KšœžœD˜aKšžœžœ
žœ
˜Kšžœ˜"J˜J˜—š
 œžœ
žœžœžœ˜?šŸœžœ
žœ˜1šžœž˜Jš
œ˜Jš
œ˜š	œžœžœžœžœ˜\Jš
œ
˜
Jš
œ˜Jšžœžœ
žœ
˜#J˜
J˜—šœžœžœžœ˜AJšœžœ
˜#Jš
œ
˜
Jš
œ˜Jšžœžœžœ
žœ
˜=J˜
Jš
œ˜Jšžœžœžœ
žœ
˜=J˜
Jš
œ˜Jšžœžœ
žœ
˜#J˜
Jš
œ˜J˜—šžœ˜Jšœžœ˜Kšœ
žœ˜š	žœžœ
žœžœ
ž˜KKšžœžœ˜5Kšžœžœ˜5Kš
œ
˜
Kšžœ
žœ
žœ
˜Kšžœ
˜—Kš
œ)˜)J˜——J˜—Jšœžœ˜Jšœžœ˜Jš
œ˜J˜—K˜š œžœ˜KšœžœD˜aJš
œ˜J˜—K˜š
Ÿœžœ
žœžœžœ˜@Kšœžœžœ
˜Kšžœ
žœ
žœžœ˜"Kšžœžœ"˜>Kšžœžœ"˜>Kšžœžœžœ
žœ˜[Kš
žœžœžœ
žœžœ˜NKšžœžœžœ
žœ
˜=Kšžœ'žœ
žœžœ˜=Kšžœ'žœ
žœžœ˜=š
ž˜Kšœžœ˜Kš
œ9˜9Kš	žœžœ
žœ
žœ‘˜+Kš
œ+˜+Kš
œ+˜+Kšžœ
žœžœ<˜KKšžœžœ˜FKšžœ
˜—K˜——™šŸ
œžœ
žœ
žœ
žœžœ˜HJšœžœ˜$Jš
œ'˜'šžœžœ
žœ
žœ
˜Jš
œH˜HJšžœ
˜—J˜—K˜Kš
œl™lšŸ
œžœžœžœ	žœžœ˜SKš
œ ˜ šžœžœ
žœžœ
˜$Kšžœ6žœ
žœžœ˜KKšžœ
˜—K˜——™4š
Ÿœžœ
žœ#žœžœ˜Lšœžœ
žœ
ž˜Jšœžœ$˜=Jšœžœ%˜?Jšœžœ%˜>Jšœžœ$˜>Jš
œ-˜-Jš
œ.˜.Jš
œ.˜.Jš
œ-˜-Jš
œ.˜.Jšžœ˜!—J˜——™KšœBžœJ˜
Kšœ>žœR˜“
Kšœ=žœO˜
K˜—Kšžœ
˜K˜
—…—+>