BooleImpl.mesa
Copyright © 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
DIRECTORY Core, Boole, CoreOps, CoreProperties, Rope, RopeList, TerminalIO;
BooleImpl: CEDAR PROGRAM
IMPORTS CoreOps, CoreProperties, Rope, RopeList, TerminalIO
EXPORTS Boole =
BEGIN
OPEN Boole;
Types and Utilities
coreBoolProcsProp: ATOM = CoreProperties.RegisterProperty[$CoreBoolProcs];
Properties on classes known by CoreBool hang on atom coreBoolProcsProp. they are of type CoreBoolProcs.
CoreBoolProcs: TYPE = REF CoreBoolProcsRec;
CoreBoolProcsRec: TYPE = RECORD [
eval: EvalProc,
toRope: ToRopeProc,
findVar: FindVarProc];
Expression Classes
Constants
constantClass: Core.CellClass ← NEW [Core.CellClassRec ← [name: "BooleConstant"]];
ConstantData: TYPE = REF ConstantDataRec;
ConstantDataRec: TYPE = RECORD [value: BOOL];
Alps
alpsClass: Core.CellClass ← NEW [Core.CellClassRec ← [name: "BooleAlps"]];
AlpsData: TYPE = REF AlpsDataRec;
AlpsDataRec: TYPE = RECORD [var: ROPE, thenExpr, elseExpr: Expression];
The invariant is that none of thenExpr and elseExpr contains variable var. The order of variables in thenExpr and elseExpr might be different
Negation
notClass: Core.CellClass ← NEW [Core.CellClassRec ← [name: "BooleNot"]];
data field of the CellType contains the Expression being negated.
Constants
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"];
Binary Operators
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] = {
It is assumed that none of expr1 and expr2 are constants
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]]
];
};
Operators returning Expressions
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]];
};
Private EvalProcs
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];
};
Private ToRopeProcs
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], "]"]];
};
Private FindVarProcs
ConstantFindVar: FindVarProc = {RETURN [NIL]};
AlpsFindVar: FindVarProc = {
alpsData: AlpsData ← NARROW [expr.data];
RETURN [alpsData.var];
};
NotFindVar: FindVarProc = {
notData: Expression ← NARROW [expr.data];
RETURN [FindVar[notData]];
};
Public operations
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;
};
Private operations
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;
};
Can only be used as an hint: if var is present, this does not imply that this variable is really significant
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;
};
Private operations that depend on the representation
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;
};
Initialization
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.