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

CoreBooleImpl: CEDAR PROGRAM
IMPORTS CoreOps, CoreProperties, Rope, RopeList, TerminalIO
EXPORTS CoreBoole = 
BEGIN 
OPEN CoreBoole;
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: "CoreBooleConstant"]];
ConstantData: TYPE = REF ConstantDataRec;
ConstantDataRec: TYPE = RECORD [value: BOOL];
alpsClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "CoreBooleAlps"]];
AlpsData: TYPE = REF AlpsDataRec;
AlpsDataRec: TYPE = RECORD [var: ROPE, thenExpr, elseExpr: Expression];
notClass: Core.CellClass _ NEW [Core.CellClassRec _ [name: "CoreBooleNot"]];
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] = {
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 "true" ELSE "false"];
};

AlpsToRope: ToRopeProc = {
alpsData: AlpsData _ NARROW [expr.data];
RETURN [Rope.Cat[
Rope.Cat["If[Var[", alpsData.var, "], "], 
ToRope[alpsData.thenExpr, deep-1],
", ", 
ToRope[alpsData.elseExpr, deep-1],
"]"]];
};

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]];
};

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

Equal: PUBLIC PROC [expr1, expr2: Expression] RETURNS [BOOL] = {
IF expr1=expr2 THEN RETURN [TRUE];
IF expr1.class=constantClass OR expr2.class=constantClass THEN RETURN [FALSE];
BEGIN
var: ROPE _ FindVar[expr1];
expr1True, expr1False, expr2True, expr2False: Expression;
IF var=NIL THEN {
TerminalIO.WriteF["Expression has no Wire\n"]; -- expr1
ERROR;
};
IF ~FindVarInExpr[var, expr2] THEN RETURN [FALSE];
[expr1True, expr1False] _ Eval[var, expr1];
[expr2True, expr2False] _ Eval[var, expr2];
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;
};
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.
 
ŒCoreBooleImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reversed.
Created by Bertrand Serlet July 31, 1985 3:03:17 pm PDT
Bertrand Serlet January 20, 1986 3:59:01 pm PST

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
Initialization
Κ‚–

"cedar" style˜
codeš
œ™Jšœ
Οm
œ1™<J™7J™/K™—KšΟk	œG˜PJ˜•StartOfExpansion[]šœžœ
ž˜Kšžœ4˜;Kšžœ
˜Kšžœ
˜Kšžœ˜
head™šœžœ3˜JKš
œh™h—Kšœžœžœ˜+šœžœžœ˜!Kš
œ˜Kš
œ˜Kš
œ˜——™™	Kšœ žœ3˜VKšœžœžœ˜)Kšœžœžœ	žœ˜-—K™™Kšœžœ/˜NKšœ
žœžœ
˜!šœ
žœžœžœ"˜GKš
œŽ
™Ž
——K™™Kšœžœ.˜LJ™A——™	Jšœžœažœžœ˜›
Jšœžœažœžœ˜ž
—š
œ™K–I -- [design: Core.Design, me: Core.CellType] RETURNS [new: Core.CellType]šΟnœžœžœžœ˜MK˜šΟbœ
˜šœ	žœ
žœ
ž˜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˜šΠbnœžœ
žœ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š
œ6˜6K˜——™š œ˜Jšœžœ
˜(Kš
œE˜EKšžœžœ
žœ(˜TKš
œ=˜=Kš
œ=˜=Kš
œ@˜@Kš
œC˜CK˜—K˜š œ˜Jšœžœ
˜)Jš
œ+˜+Kš
œ5˜5Kš
œ˜——™š œ˜Jšœžœ
˜0Jšžœžœžœžœ
˜8K˜—K˜š 
œ˜Jšœžœ
˜(šžœ˜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˜—K˜š œžœ˜KšœžœD˜aJš
œ˜J˜—K˜š
Ÿœžœ
žœžœžœ˜@Kšžœ
žœ
žœžœ˜"š
žœžœžœ
žœžœ˜NKš
ž˜Kšœžœ˜Kš
œ9˜9šžœžœ
žœ˜Kšœ/‘˜7Kšžœ
˜K˜—Kšžœžœ
žœžœ˜2Kš
œ+˜+Kš
œ+˜+Kšžœžœ˜FKšžœ
˜—K˜——™šŸ
œžœ
žœ
žœ
žœžœ˜HJšœžœ˜$Jš
œ'˜'šžœžœ
žœ
žœ
˜Jš
œH˜HJšžœ
˜—J˜—K˜Kš
œl™lšŸ
œžœžœžœ	žœžœ˜SKš
œ ˜ šžœžœ
žœžœ
˜$Kšžœ6žœ
žœžœ˜KKšžœ
˜—K˜——™KšœBžœJ˜
Kšœ>žœR˜“
Kšœ=žœO˜
—K˜—Kšžœ
˜K˜
—…—!τ1