BEImpl.mesa
Copyright © 1986 by Xerox Corporation. All rights reserved.
Last Edited by: Louis Monier September 17, 1986 7:24:40 pm PDT
DIRECTORY BE, HashTable, IO, Rope;
BEImpl: CEDAR PROGRAM
IMPORTS HashTable, IO, Rope
EXPORTS BE =
BEGIN OPEN BE;
Expression Types and Constants
ROPE: TYPE = Rope.ROPE;
true: PUBLIC Expression ← NEW [BOOLTRUE];
false: PUBLIC Expression ← NEW [BOOLFALSE];
unknown: PUBLIC Expression ← NEW [NATLAST[NAT]];
opsTable: HashTable.Table ← HashTable.Create[];
Creation Operator
-- Flushes the NILs
CreateListOpr: PROC [opr: Operator, exprs: LIST OF Expression ← NIL] RETURNS [result: Expression] = {
node: Node;
count: NAT ← 0;
FOR exprList: LIST OF Expression ← exprs, exprList.rest UNTIL exprList=NIL DO
IF exprList.first#NIL THEN count ← count + 1;
ENDLOOP;
node ← NEW [NodeRec[count]];
node.op ← opr;
count ← 0;
FOR exprList: LIST OF Expression ← exprs, exprList.rest UNTIL exprList=NIL DO
IF exprList.first#NIL THEN {node[count] ← exprs.first; count ← count + 1};
ENDLOOP;
result ← node;
};
Operators returning Expressions (general)
Not: PUBLIC PROC [expr: Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[notOpr, LIST[expr]]]};
AndList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[andOpr, exprs]]};
And: PUBLIC PROC [e1, e2, e3, e4, e5: Expression ← NIL] RETURNS [Expression] ={
RETURN [AndList[LIST[e1, e2, e3, e4, e5]]]};
OrList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[orOpr, exprs]]};
Or: PUBLIC PROC [e1, e2, e3, e4, e5: Expression ← NIL] RETURNS [Expression] = {
RETURN [OrList[LIST[e1, e2, e3, e4, e5]]]};
XorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[xorOpr, exprs]]};
Xor: PUBLIC PROC [e1, e2, e3, e4, e5: Expression ← NIL] RETURNS [Expression] = {
RETURN [XorList[LIST[e1, e2, e3, e4, e5]]]};
NandList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[nandOpr, exprs]]};
Nand: PUBLIC PROC [e1, e2, e3, e4, e5: Expression ← NIL] RETURNS [Expression] = {
RETURN [NandList[LIST[e1, e2, e3, e4, e5]]]};
NorList: PUBLIC PROC [exprs: LIST OF Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[norOpr, exprs]]};
Nor: PUBLIC PROC [e1, e2, e3, e4, e5: Expression ← NIL] RETURNS [Expression] = {
RETURN [NorList[LIST[e1, e2, e3, e4, e5]]]};
If: PUBLIC PROC [cond, then, else: Expression] RETURNS [Expression] = {
RETURN [CreateListOpr[ifOpr, LIST[cond, then, else]]];
};
Public operations
FullEval: PUBLIC PROC [expr: Expression, evalVar: EvalVar] RETURNS [Expression] = {
WITH expr SELECT FROM
node: Node => RETURN[node.op.evalProc[node, evalVar]];
ENDCASE => RETURN [evalVar[expr]];
};
PutExpr: PUBLIC PROC [out: IO.STREAM, expr: Expression, deep: INTLAST [INT], putRefAny: PROC [IO.STREAM, Variable] ← NIL] = {
Var: PROC [var: Variable] = {
WITH var SELECT FROM
constant: Constant => ERROR;
rope: ROPE  => out.PutRope[Rope.Cat["""", rope, """"]];
text: REF TEXT => out.PutRope[Rope.Cat["""", Rope.FromRefText[text], """"]];
refInt: REF INT => out.Put[IO.rope["Int["], IO.int[refInt^], IO.rope["]"]];
ENDCASE  => {
out.PutRope["Var["];
IF putRefAny=NIL THEN out.Put1[IO.refAny[var]] ELSE putRefAny[out, var];
out.PutRope["]"];
};
};
IF deep<0 THEN out.PutRope[" ... "];
WITH expr SELECT FROM
constant: Constant => out.PutRope[IF constant.value THEN "1" ELSE "0"];
node: Node => {
out.PutF["%g %g [", IO.rope[node.op.name], IO.int[node.size]];
FOR i: NAT IN [0..node.size) DO
IF i>0 THEN out.PutRope[", "];
PutExpr[out, node[i], deep-1, putRefAny];
ENDLOOP;
out.PutRope["]"];
};
ENDCASE  => Var[expr];
};
GetExpr: PUBLIC PROC [in: IO.STREAM, getRefAny: PROC [IO.STREAM] RETURNS [Variable] ← NIL] RETURNS [expr: Expression] = {
tokenKind: IO.TokenKind; token: ROPE;
[tokenKind, token] ← IO.GetCedarTokenRope[in];
SELECT TRUE FROM
Rope.Equal[token, "0"]   => RETURN [false];
Rope.Equal[token, "1"]   => RETURN [true];
Rope.Equal[token, "Int"] => {
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "["] THEN ERROR;
expr ← NEW [INTIO.GetInt[in]];
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "]"] THEN ERROR;
};
Rope.Equal[token, "Var"] => {
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "["] THEN ERROR;
expr ← getRefAny[in];
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "]"] THEN ERROR;
};
tokenKind=tokenROPE  => expr ← Rope.Substr[token, 1, Rope.Length[token]-2];
ENDCASE      => {
node: Node;
operator: Operator;
n: NAT;
operator ← NARROW[HashTable.Fetch[opsTable, token].value];
n ← IO.GetInt[in];
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "["] THEN ERROR;
node ← NEW[NodeRec[n]];
node.op ← operator;
FOR i: NAT IN [0..n) DO
IF i>0 AND NOT Rope.Equal[IO.GetCedarTokenRope[in].token, ","] THEN ERROR;
node[i] ← GetExpr[in, getRefAny];
ENDLOOP;
IF NOT Rope.Equal[IO.GetCedarTokenRope[in].token, "]"] THEN ERROR;
expr ← node;
};
};
ToRope: PUBLIC PROC [expr: Expression, deep: INT ← 5] RETURNS [ROPE] = {
out: IO.STREAMIO.ROS[];
PutExpr[out, expr, deep];
RETURN [IO.RopeFromROS[out]];
};
FromRope: PUBLIC PROC [rope: Rope.ROPE] RETURNS [Expression] = {
RETURN [GetExpr[IO.RIS[rope]]];
};
-- Defining the usual operators
AnalyzeArgs: PROC [node: Node, evalVar: EvalVar] RETURNS [allZeros, allOnes, oneZero, oneOne, oneX: BOOL] ~ {
allZeros ← TRUE;
allOnes ← TRUE;
oneZero ← oneOne ← oneX ← FALSE;
FOR i: NAT IN [0..node.size) DO
node[i] ← FullEval[node[i], evalVar];
IF node[i]=false THEN oneZero ← TRUE;
IF node[i]=true THEN oneOne ← TRUE;
allZeros ← allZeros AND (node[i]=false);
allOnes ← allOnes AND (node[i]=true);
oneX ← node[i]=unknown;
ENDLOOP;
};
Bogus: EvalProc = {RETURN[NIL]};
-- Not[X]=X
NotEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
IF node.size#1 THEN ERROR;  -- only one argument!
RETURN [SELECT TRUE FROM
oneX => unknown,
oneOne => false,
oneZero => true,
ENDCASE => expr
];
};
-- And[0, ...]=0
-- And[1, 1, 1, ...]=1
AndEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
IF oneX THEN RETURN[unknown];
IF oneZero THEN RETURN[false];
IF allOnes THEN RETURN[true];
RETURN[expr];
};
-- Or[1, ...]=1
-- Or[0, 0, 0, ...]=0
OrEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
IF oneX THEN RETURN[unknown];
IF oneOne THEN RETURN[true];
IF allZeros THEN RETURN[false];
RETURN[expr];
};
-- Nand[0, ...]=1
-- Nand[1, 1, 1, ...]=0
NandEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
IF oneX THEN RETURN[unknown];
IF oneZero THEN RETURN[true];
IF allOnes THEN RETURN[false];
RETURN[expr];
};
-- Nor[1, ...]=0
-- Nor[0, 0, 0, ...]=1
NorEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
IF oneX THEN RETURN[unknown];
IF oneOne THEN RETURN[false];
IF allZeros THEN RETURN[true];
RETURN[expr];
};
-- Xor[0, 1]=Xor[1, 0]=1
-- Xor[0, 0]=Xor[1, 1]=0
XorEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
IF node.size#2 THEN ERROR;  -- exactly two arguments!
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
SELECT TRUE FROM
oneX => RETURN[unknown];
allZeros OR allOnes => RETURN[false];
oneZero AND oneOne => RETURN[true];
ENDCASE => RETURN[expr];
};
-- XNor[0, 1]=XNor[1, 0]=0
-- XNor[0, 0]=XNor[1, 1]=1
XNorEval: EvalProc = {
node: Node ← NARROW[expr, Node];
allZeros, allOnes, oneZero, oneOne, oneX: BOOL;
IF node.size#2 THEN ERROR;  -- exactly two arguments!
[allZeros, allOnes, oneZero, oneOne, oneX] ← AnalyzeArgs[node, evalVar];
SELECT TRUE FROM
oneX => RETURN[unknown];
allZeros OR allOnes => RETURN[true];
oneZero AND oneOne => RETURN[false];
ENDCASE => RETURN[expr];
};
-- IF[0, 1]=XNor[1, 0]=0
-- XNor[0, 0]=XNor[1, 1]=1
IfEval: EvalProc = {
node: Node ← NARROW[expr, Node];
IF node.size#3 THEN ERROR;  -- exactly three arguments!
node[0] ← FullEval[node[0], evalVar];
node[1] ← FullEval[node[1], evalVar];
node[2] ← FullEval[node[2], evalVar];
IF node[0]=unknown OR node[1]=unknown OR node[2]=unknown THEN RETURN[unknown];
IF node[0]=true THEN RETURN[node[1]];
IF node[0]=false THEN RETURN[node[2]];
RETURN[expr];
};
RegisterOp: PUBLIC PROC [name: ROPE, evalProc: EvalProc] RETURNS [op: Operator] ~ {
op ← NEW[OperatorRec ← [name: name, evalProc: evalProc]];
[] ← HashTable.Store[opsTable, name, op];
};
notOpr: PUBLIC Operator ← RegisterOp[name: "Not", evalProc: NotEval];
andOpr: PUBLIC Operator ← RegisterOp[name: "And", evalProc: AndEval];
orOpr: PUBLIC Operator ← RegisterOp[name: "Or", evalProc: OrEval];
nandOpr: PUBLIC Operator ← RegisterOp[name: "Nand", evalProc: NandEval];
norOpr: PUBLIC Operator ← RegisterOp[name: "Nor", evalProc: NorEval];
xorOpr: PUBLIC Operator ← RegisterOp[name: "Xor", evalProc: XorEval];
xnorOpr: PUBLIC Operator ← RegisterOp[name: "XNor", evalProc: XNorEval];
ifOpr: PUBLIC Operator ← RegisterOp[name: "If", evalProc: IfEval];
END.