
<<BoolExImpl.mesa>>
<<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
<<Barth, July 17, 1987 5:46:59 pm PDT>>
<<Bertrand Serlet April 2, 1987 9:39:46 pm PST>>
<<Don Curry July 21, 1987 8:59:20 am PDT>>
<<Last Edited by: Don Curry December 12, 1987 11:09:33 am PST>>
<<>>
DIRECTORY Basics, BoolEx, FileNames, FS, IO, Rope, RopeList, SParse, SymTab;

BoolExImpl: CEDAR PROGRAM
IMPORTS Basics, FileNames, FS, IO, Rope, RopeList, SParse, SymTab
EXPORTS BoolEx
= BEGIN

Expression:    TYPE = BoolEx.Expression;
OpIndex:        TYPE = BoolEx.OpIndex;
LevCnt:        TYPE = RECORD[lev, cnt: INT];
traceLog:        IO.STREAM _ IO.noWhereStream;

NmOp: PUBLIC PROC[nm: IO.ROPE] RETURNS[op: OpIndex] = {
FOR op IN OpIndex DO IF nm.Equal[OpNm[op]] THEN RETURN[op] ENDLOOP;
IF nm.Equal["*"]     THEN RETURN[and];
IF nm.Equal["+"]    THEN RETURN[or];
IF nm.Equal["~"]    THEN RETURN[not];
RETURN[func]};

OpNm: PUBLIC PROC[op: OpIndex] RETURNS[nm: IO.ROPE] = {RETURN[SELECT op FROM
mach        => "MACH",
out        => "OUT",
var        => "VAR",
nand        => "NAND",
nor        => "NOR",
and        => "*",
or            => "+",
not        => "~",
ENDCASE    => "function"]};

ExpressionStats: PUBLIC PROC [expr: Expression] RETURNS [exprStatRope: IO.ROPE] = {
ScanExpr: PROC[e: REF] = {
WITH e SELECT FROM
int:    REF INT    => RETURN;
rope:    IO.ROPE    => IF SymTab.Insert[varTab, rope, rope] THEN inputs _ inputs+1;
elist:    LIST OF REF    => {
op: OpIndex _ NmOp[NARROW[elist.first]];
SELECT op FROM
mach        => {
opCnts[op][1] _ opCnts[op][1]+1;
machineName _ NARROW[elist.rest.first];
FOR el: LIST OF REF _ elist.rest.rest, el.rest WHILE el#NIL DO
dList: LIST OF REF    _ NARROW[el.first];
name: IO.ROPE        _ NARROW[dList.rest.first];
op _ NmOp[NARROW[dList.first]];
opCnts[op][1] _ opCnts[op][1]+1;
SELECT op FROM
out    =>
IF ~SymTab.Insert[outTab, name, Copy[dList.rest.rest.first]] THEN ERROR;
var    =>
IF ~SymTab.Insert[varTab, name, Copy[dList.rest.rest.first]] THEN ERROR;
ENDCASE    => ERROR;
ENDLOOP;
FOR el: LIST OF REF _ elist.rest.rest, el.rest WHILE el#NIL DO
dList: LIST OF REF    _ NARROW[el.first];
ScanExpr[dList.rest.rest.first] ENDLOOP};
out        => ERROR;    -- should have been caught above
var        => ERROR;    -- should have been caught above
ENDCASE    => {
cnt: INT _ 0;
FOR el: LIST OF REF _ elist.rest, el.rest WHILE el#NIL DO cnt _ cnt+1 ENDLOOP;
cnt _ MIN[cnt, maxCount];
opCnts[op][cnt] _ opCnts[op][cnt]+1;
FOR el: LIST OF REF _ elist.rest, el.rest WHILE el#NIL
DO ScanExpr[el.first] ENDLOOP}};
ENDCASE    =>    ERROR};
maxCount: NAT = 20;
varTab:    SymTab.Ref _ SymTab.Create[];
outTab:    SymTab.Ref _ SymTab.Create[];
stream:            IO.STREAM _ IO.ROS[];
opCnts:            ARRAY OpIndex OF ARRAY [1..maxCount] OF INT _ ALL[ALL[0]];
machineName:    IO.ROPE _ "???";
inputs:            INT _ 0;
gates:                INT _ 0;
ScanExpr[expr];
stream.PutF["%g\n     IN:%3g  ", IO.rope[machineName], IO.int[inputs]];
FOR ii: INT IN [1..maxCount] DO stream.PutF["%3g", IO.int[ii]] ENDLOOP;
stream.PutRope["\n"];
FOR op: OpIndex IN OpIndex DO
cnt: INT _ 0;
IF op=mach THEN LOOP;
FOR ii: INT IN [1..maxCount] DO cnt _ cnt+opCnts[op][ii] ENDLOOP;
stream.PutF["%7g:%3g  ", IO.rope[OpNm[op]], IO.int[cnt]];
IF op#out AND op#var THEN gates _ gates + cnt;
FOR ii: INT IN [1..maxCount] DO IF opCnts[op][ii]=0
THEN    stream.PutRope["   "]
ELSE    stream.PutF["%3g", IO.int[opCnts[op][ii]]] ENDLOOP;
stream.PutRope["\n"];
ENDLOOP;
stream.PutF["  GATES:%3g\n", IO.int[gates]];
exprStatRope _ IO.RopeFromROS[stream]};

DefaultEachInputProc:        BoolEx.EachInputProc    = {};
DefaultEachOutputProc:    BoolEx.EachOutputProc    = {};
<<>>
ScanExpression: PUBLIC PROC[
expr:            BoolEx.Expression,
eachInput:    BoolEx.EachInputProc _ NIL,
eachOutput:    BoolEx.EachOutputProc _ NIL]
RETURNS[machName: IO.ROPE _ NIL] = {
outTab:    SymTab.Ref _ SymTab.Create[];
inTab:    SymTab.Ref _ SymTab.Create[];
RegisterDefs: PROC[e: REF] = {
WITH e SELECT FROM
int:    REF INT        => RETURN;
rope:    IO.ROPE        => RETURN;
elist:    LIST OF REF    =>
SELECT NmOp[NARROW[elist.first]] FROM
mach        => {
machName _ NARROW[elist.rest.first];
FOR elist _ elist.rest.rest, elist.rest WHILE elist#NIL
DO RegisterDefs[elist.first] ENDLOOP};
out        => {
name: IO.ROPE _ NARROW[elist.rest.first];
IF SymTab.Insert[outTab,name, Copy[elist.rest.rest.first]]
THEN eachOutput[name, elist.rest.rest.first]};
var        => {
name: IO.ROPE _ NARROW[elist.rest.first];
IF NOT SymTab.Insert[inTab,name, Copy[elist.rest.rest.first]] THEN ERROR};
ENDCASE    => RETURN;
ENDCASE    =>    ERROR};
RegisterIns: PROC[e: REF] = {
WITH e SELECT FROM
int:    REF INT            => RETURN;
rope:    IO.ROPE            =>
IF SymTab.Insert[inTab, rope, rope] THEN eachInput[rope];
elist:    LIST OF REF    =>
SELECT NmOp[NARROW[elist.first]] FROM
mach        => {
FOR elist _ elist.rest.rest, elist.rest WHILE elist#NIL
DO RegisterIns[elist.first] ENDLOOP};
out, var    => RegisterIns[elist.rest.rest.first];
ENDCASE    => FOR elist _ elist.rest, elist.rest WHILE elist#NIL
DO RegisterIns[elist.first] ENDLOOP;
ENDCASE    =>    ERROR};
IF eachInput        = NIL THEN eachInput        _ DefaultEachInputProc;
IF eachOutput    = NIL THEN eachOutput    _ DefaultEachOutputProc;
RegisterDefs[expr];
RegisterIns[expr]};

<<For leaf inputs in inTab, val=key>>
GetExpressionTables: PUBLIC PROC[mach: BoolEx.Expression]
RETURNS[machName: IO.ROPE, inTab, outTab: SymTab.Ref] = {
RegisterDefs: PROC[e: REF] = {
WITH e SELECT FROM
int:    REF INT    => RETURN;
rope:    IO.ROPE    => RETURN;
elist:    LIST OF REF    =>
SELECT NmOp[NARROW[elist.first]] FROM
mach        => {
machName _ NARROW[elist.rest.first];
FOR elist _ elist.rest.rest, elist.rest WHILE elist#NIL
DO RegisterDefs[elist.first] ENDLOOP};
out        => {
name: IO.ROPE _ NARROW[elist.rest.first];
IF ~SymTab.Insert[outTab, name, Copy[elist.rest.rest.first]] THEN ERROR};
var        => {
name: IO.ROPE _ NARROW[elist.rest.first];
IF ~SymTab.Insert[inTab, name, Copy[elist.rest.rest.first]] THEN ERROR};
ENDCASE    => RETURN;
ENDCASE    =>    ERROR};
RegisterIns: PROC[e: REF] = {
WITH e SELECT FROM
int:    REF INT    => RETURN;
rope:    IO.ROPE    => []_SymTab.Insert[inTab, rope, rope]; -- succeeds if new leaf
elist:    LIST OF REF    =>
SELECT NmOp[NARROW[elist.first]] FROM
mach        => {
FOR elist _ elist.rest.rest, elist.rest WHILE elist#NIL
DO RegisterIns[elist.first] ENDLOOP};
out, var    => RegisterIns[elist.rest.rest.first];
ENDCASE    => FOR elist _ elist.rest, elist.rest WHILE elist#NIL
DO RegisterIns[elist.first] ENDLOOP;
ENDCASE    =>    ERROR};
inTab        _ SymTab.Create[];
outTab    _ SymTab.Create[];
RegisterDefs[mach];
RegisterIns[mach]};

ReadExprFile: PUBLIC PROC[name: IO.ROPE] RETURNS[expr: Expression] = {
file:    IO.ROPE _ name;
rope:    IO.ROPE;
in:        IO.STREAM;
IF file.Find["."]=-1 THEN file _ file.Cat[".expr"];
in        _ FS.StreamOpen[fileName: file, wDir: wDir ! FS.Error => {in _ NIL; CONTINUE}];
IF in=NIL THEN RETURN[NIL];
rope    _ IO.GetRope[in];
expr    _ SParse.ToTree[rope];
in.Close[]};

WriteExprFile: PUBLIC PROC[expr: Expression, indentedLevs: INT _ 2] = {
out:    IO.STREAM;
file:    IO.ROPE        _ NARROW[NARROW[expr, LIST OF REF].rest.first];
rope:    IO.ROPE        _ SParse.ToRope[expr, indentedLevs];
IF file.Find["."]=-1 THEN file _ file.Cat[".expr"];
out                    _ FS.StreamOpen[fileName: file, accessOptions: $create, wDir: wDir];
out.PutRope[rope];
out.Close[]};

wDir: IO.ROPE _ FileNames.CurrentWorkingDirectory[]; -- when module runs

Compare: PUBLIC PROC[i0, i1: REF] RETURNS[comp: Basics.Comparison] = {
IF i0=NIL AND i1=NIL THEN RETURN[equal];
IF i0=NIL THEN RETURN[less];
IF i1=NIL THEN RETURN[greater];
WITH i0 SELECT FROM
int0:    REF INT    => WITH i1 SELECT FROM
int1:    REF INT            => RETURN[Basics.CompareInt[int0^, int1^]];
ENDCASE                        => RETURN[less];
rope0:    IO.ROPE                => WITH i1 SELECT FROM
int1:    REF INT                => RETURN[greater];
rope1:    IO.ROPE                => RETURN[Rope.Compare[rope0, rope1, FALSE]];
ENDCASE                        => RETURN[less];
elist0:    LIST OF REF            => WITH i1 SELECT FROM
int1:    REF INT                => RETURN[greater];
rope1:    IO.ROPE                => RETURN[greater];
elist1:    LIST OF REF            => DO
IF (comp _ Compare[elist0.first, elist1.first])#equal THEN RETURN[comp];
elist0 _ elist0.rest;
elist1 _ elist1.rest;
IF elist0=NIL AND elist1=NIL THEN RETURN[equal];
IF elist0=NIL THEN RETURN[less];
IF elist1=NIL THEN RETURN[greater]; ENDLOOP;
ENDCASE                        => ERROR
ENDCASE    => ERROR};

Sort: PUBLIC PROC[expr: Expression] = {
SortList: PROC[init: LIST OF REF] = {
TwoRefs: TYPE = RECORD[r0,r1: REF];
done: BOOL;
FOR lst: LIST OF REF _ init, lst.rest WHILE lst#NIL DO Sort[lst.first] ENDLOOP;
DO
done _ TRUE;
FOR lst: LIST OF REF _ init, lst.rest WHILE lst.rest#NIL DO
IF Compare[lst.first, lst.rest.first]#greater THEN LOOP;
done _ FALSE;
[lst.first, lst.rest.first] _ TwoRefs[lst.rest.first, lst.first] ENDLOOP;
IF done THEN EXIT ENDLOOP};
IF expr=NIL THEN RETURN;
WITH expr SELECT FROM
int:    REF INT                => RETURN;
rope:    IO.ROPE                => RETURN;
list:    LIST OF REF            => {
op: BoolEx.OpIndex  _ NmOp[NARROW[list.first]];
SELECT op FROM
mach, var, out    =>    {SortList[list.rest.rest];    RETURN};
ENDCASE            =>    {SortList[list.rest];        RETURN}};
ENDCASE    => ERROR};

Copy: PUBLIC PROC[expr: Expression]  RETURNS[new: Expression] = {
IF expr=NIL THEN RETURN[NIL];
WITH expr SELECT FROM
int:    REF INT                 => RETURN[NEW[INT _ int^]];
rope:    IO.ROPE                => RETURN[rope];
list:    LIST OF REF            => {
lst: LIST OF REF _ list; list _ NIL;
FOR lst _ lst, lst.rest WHILE lst#NIL DO list _ CONS[Copy[lst.first], list] ENDLOOP;
lst _ list; list _ NIL;
FOR lst _ lst, lst.rest WHILE lst#NIL DO list _ CONS[lst.first, list] ENDLOOP;
RETURN[list]};
ENDCASE    => ERROR};

OpExpr: PUBLIC PROC[op: OpIndex, e1, e2: Expression] RETURNS[Expression] = {
e1 _ Copy[e1];
e2 _ Copy[e2];
<<IF e1=NIL THEN RETURN[e2];    -- This may not be right but...>>
<<IF e2=NIL THEN RETURN[e1];    -- This may not be right but...>>
IF e1=NIL THEN ERROR;
IF e2=NIL THEN ERROR;
WITH e1 SELECT FROM
rope1: IO.ROPE        => WITH e2 SELECT FROM
rope2: IO.ROPE        => RETURN[LIST[OpNm[op], rope1, rope2]];
list2:    LIST OF REF    => IF NmOp[NARROW[list2.first]]=op
THEN    RETURN[CONS        [OpNm[op], CONS[    rope1, list2.rest]    ] ]
ELSE    RETURN[LIST        [OpNm[op],             rope1, list2 ]];
ENDCASE                => ERROR;
list1:    LIST OF REF    => WITH e2 SELECT FROM
rope2: IO.ROPE        => IF NmOp[NARROW[list1.first]]=op
THEN    RETURN[CONS        [OpNm[op], CONS[    rope2, list1.rest]    ] ]
ELSE    RETURN[LIST        [OpNm[op],             rope2, list1 ]];
list2:    LIST OF REF    => {
ok1: BOOL _ NmOp[NARROW[list1.first]]=op;
ok2: BOOL _ NmOp[NARROW[list2.first]]=op;
IF ~ok1 AND ~ok2 THEN RETURN[LIST[OpNm[op], list1, list2]];
IF ~ok1 AND  ok2 THEN RETURN[CONS [OpNm[op], CONS[ list1, list2.rest]    ] ];
IF  ok1 AND ~ok2 THEN RETURN[CONS [OpNm[op], CONS[ list2, list1.rest]    ] ];
list2 _ list2.rest;
FOR list1 _ list1.rest, list1.rest WHILE list1#NIL DO
list2 _ CONS[list1.first, list2] ENDLOOP;
RETURN[CONS[OpNm[op], list2]]};
ENDCASE                => ERROR;
ENDCASE                => ERROR};

ReplaceID: PUBLIC PROC[old, new: IO.ROPE, symTab: SymTab.Ref] = {
DoReplace: PROC[expr: Expression] = {
WITH expr SELECT FROM
int:    REF INT         => RETURN;
elist:    LIST OF REF    => {
FOR elist _ elist.rest, elist.rest WHILE elist#NIL DO WITH elist.first SELECT FROM
rp: IO.ROPE     => IF rp.Equal[old] THEN elist.first _ new;
ENDCASE     => DoReplace[elist.first] ENDLOOP};
ENDCASE    => ERROR };
Replace: SymTab.EachPairAction = {
WITH val SELECT FROM
rope: IO.ROPE    =>    IF old.Equal[rope] THEN []_SymTab.Store[symTab, key, new];
ENDCASE            => DoReplace[val]};
[]_SymTab.Pairs[symTab, Replace]};

Eval: PUBLIC PROC[expr: REF, varTab: SymTab.Ref] RETURNS[BOOL] = {
<<Must be a simple expression (nand, and, nor, or, not)>>
<<All variables must be registered in varTab as "TRUE" or "FALSE">>
true:        IO.ROPE    _ "TRUE";
false:        IO.ROPE    _ "FALSE";
WITH expr SELECT FROM
rope:    IO.ROPE        => {
val: IO.ROPE;
IF rope.Equal[true]    THEN RETURN[TRUE];
IF rope.Equal[false]    THEN RETURN[FALSE];
val _ NARROW[SymTab.Fetch[varTab, rope].val];
RETURN[val.Equal[true]]};
elist:    LIST OF REF    => {
op:    OpIndex    _ NmOp[NARROW[elist.first]];
val:    BOOL        _ Eval[elist.rest.first, varTab];
IF elist.rest.rest#NIL THEN FOR elist _ elist.rest.rest, elist.rest WHILE elist#NIL
DO SELECT op FROM
nand,    and    => IF NOT    (val _ val AND    Eval[elist.first, varTab]) THEN EXIT;
nor,    or        => IF             (val _ val OR    Eval[elist.first, varTab]) THEN EXIT;
ENDCASE; ENDLOOP;
RETURN[SELECT op FROM    nand, nor, not => ~ val,    ENDCASE => val ]};
ENDCASE    =>    ERROR};

Equal: PUBLIC PROC[expr1, expr2: REF] RETURNS[equal:  BOOL _ TRUE] = {
<<Must be a simple expressions (nand, and, nor, or, not)>>
true:        IO.ROPE            _ "TRUE";
false:        IO.ROPE            _ "FALSE";
varTab:    SymTab.Ref        _ SymTab.Create[];
vars:        LIST OF IO.ROPE;
RegisterVars: PROC[e: REF] = {
WITH e SELECT FROM
rope:    IO.ROPE    =>
IF ~rope.Equal[true] AND ~rope.Equal[false] THEN vars _ CONS[rope, vars];
elist:    LIST OF REF    =>
SELECT NmOp[NARROW[elist.first]] FROM
mach, out, var, func    => ERROR;
ENDCASE    => FOR elist _ elist.rest, elist.rest WHILE elist#NIL
DO RegisterVars[elist.first] ENDLOOP;
ENDCASE    =>    ERROR};
VerifyPairEqual: PROC[vs: LIST OF IO.ROPE] = {
IF vs = NIL
THEN equal _ (Eval[expr1, varTab] = Eval[expr2, varTab])
ELSE {
[]_SymTab.Store[varTab, vs.first, true]; VerifyPairEqual[vs.rest];
IF equal THEN
[]_SymTab.Store[varTab, vs.first, false]; VerifyPairEqual[vs.rest]}};
RegisterVars[expr1];
RegisterVars[expr2];
vars _ RopeList.Sort[vars, RopeList.Compare];
FOR temp: LIST OF IO.ROPE _ vars, temp.rest WHILE temp#NIL AND temp.rest#NIL DO
IF temp.first.Equal[temp.rest.first] THEN temp.rest _ temp.rest.rest ENDLOOP;
VerifyPairEqual[vars]};
END.