DIRECTORY  BE, HashTable, IO, Rope;

BEImpl: CEDAR PROGRAM
IMPORTS HashTable, IO, Rope
EXPORTS BE = 
BEGIN OPEN BE;
ROPE: TYPE = Rope.ROPE;

true: PUBLIC Expression _ NEW [BOOL _ TRUE];
false: PUBLIC Expression _ NEW [BOOL _ FALSE];
unknown: PUBLIC Expression _ NEW [NAT _ LAST[NAT]];

opsTable: HashTable.Table _ HashTable.Create[];
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;
};
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]]];
};
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: INT _ LAST [INT], putRefAny: PROC [IO.STREAM, Variable] _ NIL] = {
Var: PROC [var: Variable] = {
WITH var SELECT FROM
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
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 [INT _ IO.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.STREAM _ IO.ROS[];
PutExpr[out, expr, deep];
RETURN [IO.RopeFromROS[out]];
};

FromRope: PUBLIC PROC [rope: Rope.ROPE] RETURNS [Expression] = {
RETURN [GetExpr[IO.RIS[rope]]];
};

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]};
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
];
};
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];
};
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];
};
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];
};
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];
};
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];
};
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];
};
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.
 
ήBEImpl.mesa
Copyright c 1986 by Xerox Corporation.  All rights reserved.
Last Edited by: Louis Monier September 17, 1986 7:24:40 pm PDT

Expression Types and Constants
Creation Operator
-- Flushes the NILs
Operators returning Expressions (general)
Public operations
constant: Constant	=> ERROR;
constant: Constant	=> out.PutRope[IF constant.value THEN "1" ELSE "0"];
-- Defining the usual operators
-- Not[X]=X
-- And[0, ...]=0
-- And[1, 1, 1, ...]=1
-- Or[1, ...]=1
-- Or[0, 0, 0, ...]=0
-- Nand[0, ...]=1
-- Nand[1, 1, 1, ...]=0
-- Nor[1, ...]=0
-- Nor[0, 0, 0, ...]=1
-- Xor[0, 1]=Xor[1, 0]=1
-- Xor[0, 0]=Xor[1, 1]=0
-- XNor[0, 1]=XNor[1, 0]=0
-- XNor[0, 0]=XNor[1, 1]=1
-- IF[0, 1]=XNor[1, 0]=0
-- XNor[0, 0]=XNor[1, 1]=1
Κφ–

"cedar" style˜
codeš
œ™Kšœ
Οm
œ1™<K™>K™—KšΟk	œžœ
žœ˜#J˜•StartOfExpansion[]šΟnœžœ
ž˜Kšžœžœ˜Kšžœ
žœ˜
Kšžœ
žœ
žœ
˜—
head™Kšžœžœžœ
˜K˜Jš	œžœžœžœžœ˜,Jš	œžœžœžœžœ˜.Jšœ	žœžœžœžœ
žœ˜3J˜Jš
œ/˜/—š
œ™K™šŸ
œžœžœ
žœžœžœ˜eKš
œ˜Kšœžœ˜šžœžœ
žœ#žœ
žœ
ž˜MKšžœžœ
žœ˜-Kšžœ
˜—Kšœžœ˜Kš
œ˜Kš
œ
˜
šžœžœ
žœ#žœ
žœ
ž˜MKšžœžœ
žœ0˜JKšžœ
˜—K˜K˜——š
œ)™)šŸœžœ
žœžœ˜<Kšžœžœ
˜,K˜—šŸœžœ
žœ	žœ
žœ
žœ˜IKšžœ!˜'—š
Ÿœžœ
žœ"žœžœ˜OKšžœ
žœ˜,K˜—šŸœžœ
žœ	žœ
žœ
žœ˜HKšžœ ˜&—š
Ÿœžœ
žœ#žœžœ˜OKšžœ	žœ˜+K˜—šŸœžœ
žœ	žœ
žœ
žœ˜IKšžœ!˜'—š
Ÿœžœ
žœ#žœžœ˜PKšžœ
žœ˜,K˜—šŸœžœ
žœ	žœ
žœ
žœ˜JKšžœ"˜(—š
Ÿœžœ
žœ#žœžœ˜QKšžœžœ˜-K˜—šŸœžœ
žœ	žœ
žœ
žœ˜IKšžœ!˜'—š
Ÿœžœ
žœ#žœžœ˜PKšžœ
žœ˜,K˜—šŸœžœ
žœ žœ˜GKšžœžœ˜6K˜——™šŸœžœ
žœ&žœ˜Sšžœžœ
ž˜Kšœžœ"˜6Kšžœžœ˜"—K˜K˜—šŸœžœ
žœžœ
žœžœžœžœžœžœ
žœžœ˜€
šŸœžœ˜šžœžœ
ž˜Kšœžœ
™Kšœžœ-˜7Kšœžœ
žœ>˜LKšœžœ
žœžœžœžœ˜Kšžœ˜
Kš
œ˜Kš
žœžœ
žœ
žœžœ˜HKš
œ˜K˜——K˜—Kšžœžœ˜$šžœžœ
ž˜Kšœ"žœžœžœ™Gš
œ˜Kšœžœžœ˜?šžœžœ
žœž˜Kšžœžœ˜Kš
œ*˜*Kšžœ
˜—Kš
œ˜K˜—Kšžœ˜—J˜J˜—šŸœžœ
žœžœ
žœ
žœžœ
žœžœžœžœ˜yJšœžœžœ
˜%Jšœžœ˜.šžœ
žœ
ž˜Jšœžœ	˜+Jšœžœ˜*š
œ˜Jš
žœ
žœžœ#žœ
žœ
˜BJšœžœžœžœ
˜!Jš
žœ
žœžœ#žœ
žœ
˜BJ˜—š
œ˜Jš
žœ
žœžœ#žœ
žœ
˜BJš
œ˜Jš
žœ
žœžœ#žœ
žœ
˜BJ˜—Jš
œK˜Kšžœ
˜Kš
œ˜Kš
œ˜Kšœžœ
˜Kšœžœ)˜:Kšœžœ˜Jš
žœ
žœžœ#žœ
žœ
˜BKšœžœ
˜Kš
œ˜šžœžœ
žœž˜Jšžœžœ
žœžœ#žœ
žœ
˜JKš
œ!˜!Kšžœ
˜—Jš
žœ
žœžœ#žœ
žœ
˜BKš
œ˜Jš
œ˜——J˜J˜—šŸœžœ
žœžœžœžœ˜HJš	œžœ
žœžœ
žœ˜Jš
œ˜Jšžœžœ˜J˜J˜—š
Ÿœžœ
žœ
žœžœ˜@Jšžœ
žœ
žœ	˜J˜—J˜K™šŸœžœ žœ,žœ˜mKšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜ šžœžœ
žœž˜Kš
œ%˜%Kšžœžœžœ
˜%Kšžœžœ
žœ
˜#Kšœžœ˜(Kšœžœ˜%Kš
œ˜Kšžœ
˜—K˜—KšŸœžœ
žœ˜ K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kš
œH˜HKšžœ
žœ
žœΟc˜1šžœžœ
žœ
ž˜Kš
œ˜Kš
œ˜Kš
œ˜Kšžœ˜Kš
œ˜—Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kš
œH˜HKšžœžœ
žœ
˜Kšžœ	žœ
žœ˜Kšžœ	žœ
žœ˜Kšžœ˜
Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kš
œH˜HKšžœžœ
žœ
˜Kšžœžœ
žœ˜Kšžœ
žœ
žœ˜Kšžœ˜
Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kš
œH˜HKšžœžœ
žœ
˜Kšžœ	žœ
žœ˜Kšžœ	žœ
žœ˜Kšžœ˜
Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kš
œH˜HKšžœžœ
žœ
˜Kšžœžœ
žœ˜Kšžœ
žœ
žœ˜Kšžœ˜
Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kšžœ
žœ
žœ ˜5Kš
œH˜Hšžœ
žœ
ž˜Kšœžœ
˜Kšœ	žœžœ˜%Kšœžœžœ˜#Kšžœžœ˜—Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšœ*ž˜/Kšžœ
žœ
žœ ˜5Kš
œH˜Hšžœ
žœ
ž˜Kšœžœ
˜Kšœ	žœžœ˜$Kšœžœžœ˜$Kšžœžœ˜—Kš
œ˜—K™K™šŸœ˜Kšœ
žœ
˜ Kšžœ
žœ
žœ ˜7Kš
œ%˜%Kš
œ%˜%Kš
œ%˜%Kš
žœžœžœžœ
žœ
˜NKšžœžœ
žœ
˜%Kšžœžœ
žœ
˜&Kšžœ˜
Kš
œ˜—K˜š
Ÿ
œžœ
žœžœžœ˜SKšœžœ1˜9Kš
œ)˜)K˜K˜—Jšœžœ7˜EJšœžœ7˜EJšœžœ5˜BJšœ	žœ9˜HJšœžœ7˜EJšœžœ7˜EJšœ	žœ9˜HJšœžœ5˜B—K˜Kšžœ
˜K˜
—…—!Δ1˜