
<<BoolExGen.mesa>>
<<Copyright Ó 1986, 1987 by Xerox Corporation.  All rights reserved.>>
<<Curry, August 5, 1987 9:56:31 am PDT>>
<<Last Edited by: Don Curry August 2, 1987 11:11:45 am PDT>>
<<>>
DIRECTORY BoolEx, IO, SymTab;

BoolExGen: CEDAR PROGRAM
IMPORTS BoolEx, IO, SymTab
EXPORTS BoolEx
= BEGIN

inType:            NAT    = default-2000;        -- for elementary type checking 
outType:            NAT    = default-1000;        -- for elementary type checking 
Context:            TYPE    = BoolEx.Context;
default:            NAT    = BoolEx.default;
InOut:            TYPE    = BoolEx.InOut;

Create:    PUBLIC PROC[name: IO.ROPE] RETURNS[ctx: Context] = {
RETURN[NEW[BoolEx.ContextRec _ [
name:            name,
expr:            NIL,
logic:            LIST[NIL],
data:            LIST[NIL],
declares:        NIL,            -- Used during    declarations
signals:        NIL,            -- Used after all declarations
termIndex:    0,
outTermTab:    SymTab.Create[],
invTab:        SymTab.Create[] ] ] ]};

Declare: PUBLIC PROC [ctx: Context, name: IO.ROPE, io: InOut, size: NAT _ 1]
RETURNS [ix: NAT] = {
ix _ IF ctx.declares=NIL THEN 0 ELSE ctx.declares.first.index+1;
ctx.declares _ CONS[[name, io, size, ix], ctx.declares];
ix _ ix + (IF io=in THEN inType ELSE outType)};

If: PUBLIC PROC[ctx: Context, f, v: NAT, m: NAT _ default] = {
currentLogic: BoolEx.CurrentLogic    _ ctx.logic.first;
IF f = default OR v = default        THEN ERROR;
IF f NOT IN [inType..outType)    THEN ERROR;
currentLogic    _ CONS[[f-inType, v, m], currentLogic];
ctx.logic    _ CONS[currentLogic,    ctx.logic];
ctx.data    _ CONS[ctx.data.first,    ctx.data]};

And: PUBLIC PROC[ctx: Context, f, v: NAT, m: NAT _ default] = {
currentLogic: BoolEx.CurrentLogic    _ ctx.logic.first;
IF f = default OR v = default        THEN ERROR;
IF f NOT IN [inType..outType)    THEN ERROR;
currentLogic    _ CONS[[f-inType, v, m], currentLogic];
ctx.logic.first    _ currentLogic};

AddOut: PUBLIC PROC[ctx: Context, f, v: NAT, m: NAT _ default] = {
currentData: BoolEx.CurrentData    _ ctx.data.first;
IF f = default OR v = default THEN ERROR;
IF f NOT IN [outType..default) THEN ERROR;
currentData    _ CONS[[f-outType, v, m], currentData];
ctx.data.first    _ currentData};

EndIf: PUBLIC PROC[ctx: Context]= {
GetInv: PROC[nm: IO.ROPE] RETURNS[inv: IO.ROPE] = {
inv _ NARROW[SymTab.Fetch[ctx.invTab, nm].val];
IF inv=NIL THEN {
def:        LIST OF REF;
inv        _ IO.PutFR["NOT%g", IO.rope[nm]];
def        _ LIST[NEW[BoolEx.OpIndex _ not], nm];
def        _ LIST[NEW[BoolEx.OpIndex _ term], inv, def];
ctx.expr        _ CONS[def, ctx.expr];
[]_SymTab.Store[ctx.invTab, nm, inv]} };
def:        LIST OF REF _ NIL;
term:        LIST OF REF _ NIL;
termNm:    IO.ROPE _ IO.PutFR["xT%03g", IO.int[ctx.termIndex]];
IF ctx.termIndex=0 THEN {
ctx.signals _ NEW [BoolEx.SignalSeqRec[ctx.declares.first.index+1]];
FOR decl: LIST OF BoolEx.Declaration _ ctx.declares, decl.rest WHILE decl#NIL DO
ctx.signals[decl.first.index] _ decl.first; ENDLOOP};
ctx.termIndex _ ctx.termIndex+1;
FOR logic: BoolEx.CurrentLogic _ ctx.logic.first, logic.rest    WHILE logic#NIL DO
name:        IO.ROPE    _ ctx.signals[logic.first.f].name;
size:        NAT        _ ctx.signals[logic.first.f].size;
v:            NAT        _ logic.first.v;
m:            NAT        _ logic.first.m;
IF ctx.signals[logic.first.f].io#in THEN ERROR;
IF size=1
THEN {IF (m MOD 2)=1 THEN
term _ CONS[(IF (v MOD 2)=1 THEN name ELSE GetInv[name]), term]}
ELSE FOR bit: NAT DECREASING IN [0..size) DO
bitNm:    IO.ROPE    _ IO.PutFR["%g%g", IO.rope[name], IO.int[bit]];
bitOne:    BOOL        _ (v MOD 2)=1;
msk:        BOOL        _ (m MOD 2)=1;
v _ v/2; m _ m/2;
IF ~msk THEN LOOP;
term _ CONS[(IF bitOne THEN bitNm ELSE GetInv[bitNm]), term] ENDLOOP;
ENDLOOP;
term        _ CONS[NEW[BoolEx.OpIndex _ and], term];
def        _ LIST[NEW[BoolEx.OpIndex _ term], termNm, term];
ctx.expr        _ CONS[def, ctx.expr];
FOR data: BoolEx.CurrentData _ ctx.data.first, data.rest    WHILE data#NIL DO
OrToOutput: PROC[out: IO.ROPE] = {
outTerms: LIST OF REF _ NARROW[SymTab.Fetch[ctx.outTermTab, out].val];
outTerms _ CONS[termNm, outTerms];
[]_SymTab.Store[ctx.outTermTab, out, outTerms]};
name:    IO.ROPE        _ ctx.signals[data.first.f].name;
size:    NAT            _ ctx.signals[data.first.f].size;
v:        NAT            _ data.first.v;
IF ctx.signals[data.first.f].io#out THEN ERROR;
IF size=1
THEN {IF (v MOD 2)=1 THEN OrToOutput[name]}
ELSE FOR bit: NAT DECREASING IN [0..size) DO
bitNm:    IO.ROPE    _ IO.PutFR["%g%g", IO.rope[name], IO.int[bit]];
bitOne:    BOOL        _ (v MOD 2)=1;
v _ v/2;
IF bitOne THEN OrToOutput[bitNm] ENDLOOP;
ENDLOOP;
ctx.logic    _ ctx.logic.rest;
ctx.data    _ ctx.data.rest};

Finish: PUBLIC PROC[ctx: Context] RETURNS[mach: LIST OF REF] = {
OutDefs: SymTab.EachPairAction = {
def:        LIST OF REF;
outSum:    LIST OF REF    _ NARROW[val];
outSum    _ CONS[NEW[BoolEx.OpIndex _ or], outSum];
def        _ LIST[NEW[BoolEx.OpIndex _ out], key, outSum];
ctx.expr        _ CONS[def, ctx.expr]};
[]_SymTab.Pairs[ctx.outTermTab, OutDefs];
ctx.expr _ CONS[NEW[BoolEx.OpIndex _ mach], CONS[ctx.name, ctx.expr]];
IF ctx.logic.rest    #NIL THEN ERROR;
IF ctx.data.rest    #NIL THEN ERROR;
IF ctx.logic.first    #NIL THEN ERROR;
IF ctx.data.first    #NIL THEN ERROR;
BoolEx.Sort[ctx.expr];
RETURN[NARROW[ctx.expr]]};
END.