File: BoolOpsImplA.mesa   
Copyright © 1984 by Xerox Corporation. All rights reserved.
Created by: Mayo, July 16, 1984 4:44:25 pm PDT
Last Edited by: Mayo, August 30, 1984 6:07:55 pm PDT
DIRECTORY
BoolOps,
Atom USING [MakeAtom, GetPName],
RefTab,
Convert,
IO,
Rope;
BoolOpsImplA: CEDAR PROGRAM    
IMPORTS RefTab, Convert, IO, Rope, Atom EXPORTS BoolOps = BEGIN
OPEN BoolOps;
TokenTypes: TYPE = {Id, SubTree, Not, And, Or, LParen, RParen, End, Null};
precedence: ARRAY TokenTypes OF Rope.ROPE ← [
-- ISNAOLREN
-- duonrPPnu
-- btd aadl
-- Id -- "..>>>>>>.",
--Subt-- ".........",
--Not -- "<.<>><>>.",
--And -- "<.<=><>>.",
--Or -- "<.<<=<>>.",
--LPar-- "<.<<<<=..",
--RPar-- "..>>>.>>.",
--End -- "<.<<<<...",
--Null-- "........."
];
tokenNames: ARRAY TokenTypes OF Rope.ROPE ← ["", "", "~", "AND", "OR", "(", ")", "", ""];
Error: PUBLIC ERROR[ec: ErrorCode, msg: Rope.ROPE] = CODE;
Convert a rope into an expresion tree.
RopeToTree: PUBLIC PROC [expr: Rope.ROPE] RETURNS [tree: Tree] = BEGIN
Use an operator precedence parser to parse our expressions: (straight out of Aho & Ullman)
E -> id
E -> NOT E
E -> (E)
E -> E AND E
E -> E OR E
Token: TYPE = RECORD [
type: TokenTypes,
name: Rope.ROPENIL,
value: SubTree ← NIL
];
Input: TYPE = RECORD [
value: Rope.ROPE,
index: CARDINAL ← 0
];
Stack: TYPE = LIST OF Token;
NextToken: PROC [in: IO.STREAM] RETURNS[Token] = BEGIN
tok: Rope.ROPE;
eof: BOOLFALSE;
[ , tok, ] ← IO.GetCedarTokenRope[in !
IO.Error => {eof ← TRUE; CONTINUE};
IO.EndOfStream => {eof ← TRUE; CONTINUE}
];
IF eof THEN RETURN[[$End, ""]];
FOR t: TokenTypes IN TokenTypes DO
IF Rope.Equal[tok, tokenNames[t]] THEN RETURN[[t, tok]];
ENDLOOP;
RETURN[[$Id, tok]];
END;
Push: PROC [s: Stack, t: Token] RETURNS[Stack] = BEGIN
RETURN[CONS[t, s]];
END;
Pop: PROC [s: Stack] RETURNS[Stack, Token] = BEGIN
IF s = NIL THEN RETURN[NIL, [$Null, "(Stack underflow)", NIL]];
RETURN[s.rest, s.first];
END;
Peek: PROC [s: Stack] RETURNS[Token] = BEGIN
IF s = NIL THEN RETURN[[$Null, "(Stack underflow)", NIL]];
RETURN[s.first];
END;
PeekUnder: PROC [s: Stack] RETURNS[Token] = BEGIN
-- return the first terminal token on the stack
FOR tlist: Stack ← s, tlist.rest WHILE tlist # NIL DO
IF tlist.first.type # $SubTree THEN RETURN[tlist.first];
ENDLOOP;
RETURN[[$Null, "(Stack underflow)", NIL]];
END;
Precedence: PROC [tokl, tokr: TokenTypes] RETURNS[CHAR] = BEGIN
RETURN[Rope.Fetch[precedence[tokl], ORD[tokr]]];
END;
in: IO.STREAMIO.RIS[expr];
s: Stack ← NIL;
p, curToken: Token;
s ← Push[s, [$End, NIL]];
curToken ← [$Null, NIL, NIL];
DO
IF curToken.type = $Null THEN curToken ← NextToken[in];
p ← PeekUnder[s];
SELECT Precedence[p.type, curToken.type] FROM
'<, '= => { -- shift
s ← Push[s, curToken];
curToken.type ← $Null;
};
'> => { -- reduce
top, rp: Token;
topOp: Token ← [$Null, NIL, NIL];
newt: Token;
haveOp: BOOLFALSE;
op: Operator;
opId: TokenTypes;
numArgs: CARDINAL ← 0;
newt.type ← $SubTree;
newt.name ← "";
DO
[s, top] ← Pop[s];
IF top.type # SubTree THEN topOp ← top;
SELECT top.type FROM
$Id => {
newt.value ← NEW[Leaf];
NARROW[newt.value, REF Leaf].var ← Atom.MakeAtom[top.name];
newt.name ← top.name;
};
$SubTree => {
IF newt.value = NIL THEN newt.value ← NEW[Expression];
NARROW[newt.value, REF Expression].children ← CONS[top.value, NARROW[newt.value, REF Expression].children];
newt.name ← Rope.Cat[" (", top.name, ")", newt.name];
numArgs ← numArgs + 1;
};
$Or, $And, $Not => {
newOp: Operator;
SELECT top.type FROM
$Or => newOp ← $Or;
$And => newOp ← $And;
$Not => newOp ← $Not;
ENDCASE => newOp ← $None;
IF haveOp THEN {
-- parser design error: two $Nots or more than one operator for a set of variables
IF op # newOp OR op = $Not THEN ERROR Error[InternalError, "Parser screwup."];
}
ELSE {
haveOp ← TRUE;
op ← newOp;
opId ← top.type;
};
};
ENDCASE;
rp ← Peek[s];
IF rp.type # $SubTree AND topOp.type # $Null THEN {
SELECT Precedence[rp.type, topOp.type] FROM
'< => EXIT;
'= => NULL;
'> => ERROR;
ENDCASE => GOTO syntax;
};
ENDLOOP;
IF haveOp THEN {
IF numArgs < 1 THEN GOTO syntax;
IF op = $Not AND numArgs > 1 THEN GOTO syntax;
newt.name ← Rope.Cat[tokenNames[opId], newt.name];
NARROW[newt.value, REF Expression].op ← op;
}
ELSE {
IF numArgs > 1 THEN GOTO syntax;
IF ISTYPE[newt.value, REF Expression] THEN {
e: REF Expression ← NARROW[newt.value, REF Expression];
IF e # NIL AND e.children # NIL THEN
newt.value ← e.children.first;
};
};
IF curToken.type = $End AND Peek[s].type = $End THEN
RETURN[newt.value];
s ← Push[s, newt];
};
ENDCASE => GOTO syntax;
ENDLOOP;
EXITS
syntax => ERROR Error[SyntaxError, "Syntax error in expression."];
END;
Convert an expression tree into a rope.
TreeToRope: PUBLIC PROC [tree: Tree] RETURNS [Rope.ROPE] = BEGIN
result: Rope.ROPENIL;
IF tree = NIL THEN RETURN[""];
WITH tree SELECT FROM
l: REF Leaf => {
IF l.neg THEN
RETURN[Rope.Concat[tokenNames[$Not], Atom.GetPName[l.var]]]
ELSE
RETURN[Atom.GetPName[l.var]];
};
e: REF Expression => {
opName: Rope.ROPE;
haveArg: BOOLFALSE;
SELECT e.op FROM
$Not => opName ← tokenNames[$Not];
$Or => opName ← tokenNames[$Or];
$And => opName ← tokenNames[$And];
$None => opName ← "";
ENDCASE => ERROR Error[UnknownOperator, "Unknown operator in expression tree."];
IF e.op = $Not THEN
result ← opName
ELSE
result ← "";
FOR st: LIST OF SubTree ← e.children, st.rest WHILE st # NIL DO
stName: Rope.ROPE;
stName ← TreeToRope[st.first];
IF ~ISTYPE[st.first, REF Leaf] THEN
stName ← Rope.Cat["(", stName, ")"];
IF e.op = $Not THEN
result ← Rope.Cat[result, " ", stName]
ELSE {
IF haveArg THEN
result ← Rope.Cat[result, " ", opName, " ", stName]
ELSE
result ← Rope.Cat[result, stName];
};
haveArg ← TRUE;
ENDLOOP;
RETURN[result];
};
ENDCASE => ERROR Error[BadPointer, "Tree is malformed, a pointer points to something other than a subtree or a node."];
END;
AppendTreeLists: PROC [l1, l2: LIST OF SubTree] RETURNS [LIST OF SubTree] = BEGIN
t: LIST OF SubTree ← l1;
FOR tl: LIST OF SubTree ← l2, tl.rest WHILE tl # NIL DO
t ← CONS[tl.first, t];
ENDLOOP;
RETURN[t];
END;
Perform logical operations on SOP trees to produce another tree in SOP form.
SOPNot: PUBLIC PROC [tree: Tree] RETURNS [Tree] = BEGIN
IF tree = NIL THEN ERROR Error[TreeIsNil, "Tree is NIL."];
WITH tree SELECT FROM
l: REF Leaf => {
l2: REF Leaf ← NEW[Leaf ← l^];
l2.neg ← ~l2.neg;
RETURN[l2];
};
e: REF Expression => {
finalt: Tree ← NIL;
IF e.children = NIL OR e.children.first = NIL THEN ERROR Error[EmptyExpression, "Empty expression."];
SELECT e.op FROM
$Not => {
RETURN[e.children.first];
};
$Or, $And => {
-- use DeMorgan's law
finalt: Tree ← NIL;
IF e.children.rest = NIL THEN -- only one term
RETURN[SOPNot[e.children.first]];
FOR tl: LIST OF Tree ← e.children, tl.rest WHILE tl # NIL DO
t: SubTree;
t ← TreeToSOP[tl.first];
t ← SOPNot[t];
IF e.op = $And THEN
finalt ← SOPOr[finalt, t]
ELSE
finalt ← SOPAnd[finalt, t];
ENDLOOP;
RETURN[finalt];
};
$None => {
RETURN[SOPNot[e.children.first]];
};
ENDCASE => ERROR Error[UnknownOperator, "Unknown operator."];
};
ENDCASE => ERROR Error[BadPointer, "Tree is malformed, a pointer points to something other than a subtree or a node."];
END;
SOPAnd: PUBLIC PROC [tree1, tree2: Tree] RETURNS [Tree] = BEGIN
e: REF Expression ← NEW[Expression];
l1, l2: LIST OF SubTree;
IF tree1 = NIL THEN RETURN[tree2];
IF tree2 = NIL THEN RETURN[tree1];
e.op ← $Or;
e.children ← NIL;
-- create two lists of things to be ANDed together.
IF ISTYPE[tree1, REF Expression] AND NARROW[tree1, REF Expression].op = $Or THEN
l1 ← NARROW[tree1, REF Expression].children
ELSE
l1 ← CONS[tree1, NIL];
IF ISTYPE[tree2, REF Expression] AND NARROW[tree2, REF Expression].op = $Or THEN
l2 ← NARROW[tree2, REF Expression].children
ELSE
l2 ← CONS[tree2, NIL];
-- now form the cross product of the lists
FOR list1: LIST OF SubTree ← l1, list1.rest WHILE list1 # NIL DO
FOR list2: LIST OF SubTree ← l2, list2.rest WHILE list2 # NIL DO
-- create one AND term
and: REF Expression ← NEW[Expression];
and.op ← $And;
IF ISTYPE[list1.first, REF Expression] AND NARROW[list1.first, REF Expression].op = $And THEN {
and.children ← AppendTreeLists[NARROW[list1.first, REF Expression].children, and.children];
}
ELSE {
and.children ← CONS[list1.first, and.children];
};
IF ISTYPE[list2.first, REF Expression] AND NARROW[list2.first, REF Expression].op = $And THEN {
and.children ← AppendTreeLists[NARROW[list2.first, REF Expression].children, and.children];
}
ELSE {
and.children ← CONS[list2.first, and.children];
};
e.children ← CONS[and, e.children];
ENDLOOP;
ENDLOOP;
RETURN[e];
END;
SOPOr: PUBLIC PROC [tree1, tree2: Tree] RETURNS [Tree] = BEGIN
e: REF Expression ← NEW[Expression];
IF tree1 = NIL THEN RETURN[tree2];
IF tree2 = NIL THEN RETURN[tree1];
e.op ← $Or;
e.children ← NIL;
IF ISTYPE[tree1, REF Expression] AND NARROW[tree1, REF Expression].op = $Or THEN {
e.children ← AppendTreeLists[NARROW[tree1, REF Expression].children, e.children];
}
ELSE {
e.children ← CONS[tree1, e.children];
};
IF ISTYPE[tree2, REF Expression] AND NARROW[tree2, REF Expression].op = $Or THEN {
e.children ← AppendTreeLists[NARROW[tree2, REF Expression].children, e.children];
}
ELSE {
e.children ← CONS[tree2, e.children];
};
RETURN[e];
END;
Convert an arbitrary expression tree into sum-of-products form.
TreeToSOP: PUBLIC PROC [tree: Tree] RETURNS [Tree] = BEGIN
IF tree = NIL THEN ERROR Error[TreeIsNil, "Tree is NIL."];
WITH tree SELECT FROM
l: REF Leaf => RETURN[tree];
e: REF Expression => {
IF e.children = NIL OR e.children.first = NIL THEN ERROR Error[EmptyExpression, "Empty expression."];
SELECT e.op FROM
$Not => {
t: Tree;
t ← TreeToSOP[e.children.first];
t ← SOPNot[t];
RETURN[t];
};
$Or, $And => {
finalt: Tree ← NIL;
FOR tl: LIST OF Tree ← e.children, tl.rest WHILE tl # NIL DO
t: SubTree;
t ← TreeToSOP[tl.first];
IF e.op = $Or THEN
finalt ← SOPOr[finalt, t]
ELSE
finalt ← SOPAnd[finalt, t];
ENDLOOP;
RETURN[finalt];
};
$None => {
RETURN[TreeToSOP[e.children.first]];
};
ENDCASE => ERROR Error[UnknownOperator, "Unknown operator."];
};
ENDCASE => ERROR Error[BadPointer, "Tree is malformed, a pointer points to something other than a subtree or a node."];
END;
SOPToTT: PUBLIC PROC [inputs: LIST OF ATOM, equations: LIST OF Tree] RETURNS [TruthTable] = BEGIN
MakeTerm: PROC [ins, outs: CARDINAL, outputNumber: CARDINAL, inAtoms: RefTab.Ref, nv: LIST OF Leaf] RETURNS [REF PTerm] = BEGIN
term: REF PTerm ← NEW[PTerm[ins + outs]];
FOR i: INT IN [0 .. ins + outs) DO
IF i < ins THEN term[i] ← $NC ELSE term[i] ← $Zero;
ENDLOOP;
FOR var: LIST OF Leaf ← nv, var.rest WHILE var # NIL DO
val: REF;
num: REF INT;
found: BOOL;
[found, val] ← RefTab.Fetch[inAtoms, var.first.var];
IF ~found THEN ERROR Error[VariableNotAnInput, "Variable is not an input."];
num ← NARROW[val];
IF var.first.neg THEN
term[num^] ← $Zero
ELSE
term[num^] ← $One;
ENDLOOP;
term[ins + outputNumber] ← $One;
RETURN[term];
END;
AddVar : PROC [t: Tree, v: LIST OF Leaf] RETURNS[LIST OF Leaf] = BEGIN
WITH t SELECT FROM
l: REF Leaf => {
RETURN[CONS[l^, v]];
};
ENDCASE => GOTO notSOP;
EXITS
notSOP => ERROR Error[NotSOP, "Expression is not in Sum-Of-Products form."];
END;
AddTerm: PROC [t: Tree, v: LIST OF Leaf] RETURNS[LIST OF Leaf] = BEGIN
WITH t SELECT FROM
l: REF Leaf => {
v ← AddVar[t, v];
};
e: REF Expression => {
IF e.children = NIL OR e.children.first = NIL THEN ERROR Error[EmptyExpression, "Empty expression."];
SELECT e.op FROM
$And => {
FOR ch: LIST OF Tree ← e.children, ch.rest WHILE ch # NIL DO
v ← AddVar[ch.first, v];
ENDLOOP;
};
ENDCASE => GOTO notSOP;
};
ENDCASE => ERROR Error[BadPointer, "Tree is malformed, a pointer points to something other than a subtree or a node."];
RETURN[v];
EXITS
notSOP => ERROR Error[NotSOP, "Expression is not in Sum-Of-Products form."];
END;
ins, outs, pterms: INT ← 0;
termList: LIST OF REF PTerm ← NIL;
outputNumber: INT ← 0;
atomTab: RefTab.Ref ← RefTab.Create[150];  -- maps ATOMS -> input positions
tt: TruthTable ← NIL;
-- record inputs
FOR inp: LIST OF ATOM ← inputs, inp.rest WHILE inp # NIL DO
IF ~RefTab.Store[atomTab, inp.first, NEW[INT ← ins]] THEN
ERROR Error[DoubleInputs, "Same input appears more than once."];
ins ← ins + 1;
ENDLOOP;
-- make the product terms
FOR out: LIST OF Tree ← equations, out.rest WHILE out # NIL DO
outs ← outs + 1; ENDLOOP;
FOR out: LIST OF Tree ← equations, out.rest WHILE out # NIL DO
t: Tree ← out.first;
nv: LIST OF Leaf ← NIL;
WITH t SELECT FROM
l: REF Leaf => {
nv ← AddVar[t, NIL];
termList ← CONS[MakeTerm[ins, outs, outputNumber, atomTab, nv], termList];
pterms ← pterms + 1;
};
e: REF Expression => {
IF e.children = NIL OR e.children.first = NIL THEN ERROR Error[EmptyExpression, "Empty expression."];
SELECT e.op FROM
$And => {
nv ← AddTerm[t, NIL];
termList ← CONS[MakeTerm[ins, outs, outputNumber, atomTab, nv], termList];
pterms ← pterms + 1;
};
$Or => {
FOR term: LIST OF Tree ← e.children, term.rest WHILE term # NIL DO
nv ← AddTerm[term.first, NIL];
termList ← CONS[MakeTerm[ins, outs, outputNumber, atomTab, nv], termList];
pterms ← pterms + 1;
ENDLOOP;
};
ENDCASE => GOTO notSOP;
};
ENDCASE => ERROR Error[BadPointer, "Tree is malformed, a pointer points to something other than a subtree or a node."];
outputNumber ← outputNumber + 1;
ENDLOOP;
-- create the truth table
tt ← NEW[TruthTableRec[pterms]];
tt.numInputs ← ins;
tt.numOutputs ← outs;
tt.numPTerms ← pterms;
FOR i: INT DECREASING IN [0..pterms) DO
tt.pterms[i] ← termList.first;
termList ← termList.rest;
ENDLOOP;
RETURN[tt];
EXITS
notSOP => ERROR Error[NotSOP, "Expression is not in Sum-Of-Products form."];
END;
TTToStream: PUBLIC PROC [tt: TruthTable, out: IO.STREAM] = BEGIN
IF tt = NIL THEN ERROR Error[TTIsNil, "NIL truth table."];
FOR i: INT IN [0..tt.numPTerms) DO
FOR j: INT IN [0..tt.numInputs+tt.numOutputs) DO
IF j = tt.numInputs THEN IO.PutRope[out, " | "];
SELECT tt.pterms[i].bits[j] FROM
$One => IO.PutChar[out, '1];
$Zero => IO.PutChar[out, '0];
$NC => IO.PutChar[out, 'x];
ENDCASE => ERROR Error[UnknownTTBit, "Strange bit in truth table"];
ENDLOOP;
IO.PutChar[out, '\n];
ENDLOOP;
END;
BerkeleyTTToStream: PUBLIC PROC [tt: TruthTable, out: IO.STREAM] = BEGIN
IF tt = NIL THEN ERROR Error[TTIsNil, "NIL truth table."];
IO.PutF[out, ".i %g\n.o %g\n.p %g\n", IO.int[tt.numInputs], IO.int[tt.numOutputs], IO.int[tt.numPTerms]];
FOR i: INT IN [0..tt.numPTerms) DO
FOR j: INT IN [0..tt.numInputs+tt.numOutputs) DO
IF j = tt.numInputs THEN IO.PutRope[out, " "];
SELECT tt.pterms[i].bits[j] FROM
$One => IO.PutChar[out, '1];
$Zero => IO.PutChar[out, '0];
$NC => IO.PutChar[out, 'x];
ENDCASE => ERROR Error[UnknownTTBit, "Strange bit in truth table"];
ENDLOOP;
IO.PutChar[out, '\n];
ENDLOOP;
IO.PutF[out, ".e\n"];
END;
StreamToTT: PUBLIC PROC [in: IO.STREAM] RETURNS [TruthTable] = BEGIN
ins, outs, pterms: INT ← 0;
termList: LIST OF REF PTerm ← NIL;
r: Rope.ROPE;
tTable: TruthTable;
haveDotE: BOOLFALSE;
eof: BOOLFALSE;
-- get product terms
DO
index: INT;
term: REF PTerm;
r ← IO.GetLineRope[in ! IO.EndOfStream => {eof ← TRUE; CONTINUE}];
IF eof THEN EXIT;
IF Rope.Length[r] < 1 OR Rope.Fetch[r, 0] = '# THEN LOOP;
-- first pterm, count number of inputs and outputs
IF pterms = 0 THEN {
numBits: INT ← 0;
FOR j: INT IN [0..Rope.Length[r]) DO
ch: CHAR ← Rope.Fetch[r, j];
SELECT ch FROM
'| => ins ← numBits;
' , '\n, '\t => LOOP;
'0, '1, '-, 'x, 'X => numBits ← numBits + 1;
ENDCASE => {
ERROR Error[SyntaxError, Rope.Cat["Bad character ", Convert.RopeFromChar[ch], " in truth table."]];
};
ENDLOOP;
outs ← numBits - ins;
IF ins < 1 OR outs < 1 THEN GOTO shortTerm;
};
-- fill in bits of product term
term ← NEW[PTerm[ins + outs]];
index ← 0;
FOR j: INT IN [0..Rope.Length[r]) DO
ch: CHAR ← Rope.Fetch[r, j];
SELECT ch FROM
'| => {
IF ins < index THEN
GOTO longTerm
ELSE {
IF ins > index THEN
GOTO shortTerm;
};
LOOP;
};
' , '\n, '\t => LOOP;
'0 => {
IF index >= ins + outs THEN GOTO longTerm;
term.bits[index] ← $Zero;
};
'1 => {
IF index >= ins + outs THEN GOTO longTerm;
term.bits[index] ← $One;
};
'-, 'x, 'X => {
IF index >= ins + outs THEN GOTO longTerm;
term.bits[index] ← $NC;
};
ENDCASE => {
ERROR Error[SyntaxError, Rope.Cat["Bad character ", Convert.RopeFromChar[ch], " in truth table."]];
};
index ← index + 1;
ENDLOOP;
IF index # ins + outs THEN GOTO shortTerm;
termList ← CONS[term, termList]; pterms ← pterms + 1;
ENDLOOP;
-- make the truth table from our list of product terms
IF pterms < 1 THEN GOTO earlyEnd;
tTable ← NEW[TruthTableRec[pterms]];
tTable.numInputs ← ins;
tTable.numOutputs ← outs;
tTable.numPTerms ← pterms;
FOR i: INT DECREASING IN [0..pterms) DO
tTable.pterms[i] ← termList.first;
termList ← termList.rest;
ENDLOOP;
RETURN[tTable];
EXITS
earlyEnd => ERROR Error[SyntaxError, "Truth table ends early."];
longTerm => ERROR Error[SyntaxError, "Product term is too long."];
shortTerm => ERROR Error[SyntaxError, "Product term is too short."];
END;
BerkeleyStreamToTT: PUBLIC PROC [in: IO.STREAM] RETURNS [TruthTable] = BEGIN
ins, outs, pterms: INT ← 0;
termList: LIST OF REF PTerm ← NIL;
r: Rope.ROPE;
tTable: TruthTable;
haveDotE: BOOLFALSE;
eof: BOOLFALSE;
GetInt: PROC [r: Rope.ROPE, pos: INT] RETURNS [INT] = BEGIN
i: INT;
bad: BOOLFALSE;
i ← Convert.IntFromRope[Rope.Substr[r, pos] !Convert.Error => bad ← TRUE];
IF bad THEN ERROR Error[SyntaxError, "Could not understand one of the '.' directives."];
RETURN[i];
END;
-- get product terms
DO
index: INT;
done: BOOLFALSE;
term: REF PTerm;
DO
r ← IO.GetLineRope[in ! IO.EndOfStream => {eof ← TRUE; CONTINUE}];
IF eof THEN EXIT;
IF Rope.Length[r] < 1 OR Rope.Fetch[r, 0] = '# THEN LOOP;
IF Rope.Fetch[r, 0] = '. THEN {
SELECT Rope.Fetch[r, 1] FROM
'i => IF ins < 1 THEN ins ← GetInt[r, 2] ELSE GOTO directive;
'o => IF outs < 1 THEN outs ← GetInt[r, 2] ELSE GOTO directive;
'p => NULL;
'e => done ← TRUE;
ENDCASE => GOTO directive;
}
ELSE
EXIT;
ENDLOOP;
IF done THEN EXIT;
IF ins < 1 OR outs < 1 THEN ERROR Error[SyntaxError, "Bad number of inputs or outputs."];
term ← NEW[PTerm[ins + outs]];
index ← 0;
FOR j: INT IN [0..Rope.Length[r]) DO
ch: CHAR ← Rope.Fetch[r, j];
SELECT ch FROM
' , '\n, '\t => LOOP;
'0 => {
IF index >= ins + outs THEN GOTO longTerm;
term.bits[index] ← $Zero;
};
'1 => {
IF index >= ins + outs THEN GOTO longTerm;
term.bits[index] ← $One;
};
'-, 'x, 'X => {
IF index >= ins + outs THEN GOTO longTerm;
term.bits[index] ← $NC;
};
ENDCASE => {
ERROR Error[SyntaxError, Rope.Cat["Bad character ", Convert.RopeFromChar[ch], " in truth table."]];
};
index ← index + 1;
ENDLOOP;
IF index # ins + outs THEN GOTO shortTerm;
termList ← CONS[term, termList]; pterms ← pterms + 1;
ENDLOOP;
-- make the truth table from our list of product terms
IF pterms < 1 THEN GOTO earlyEnd;
tTable ← NEW[TruthTableRec[pterms]];
tTable.numInputs ← ins;
tTable.numOutputs ← outs;
tTable.numPTerms ← pterms;
FOR i: INT DECREASING IN [0..pterms) DO
tTable.pterms[i] ← termList.first;
termList ← termList.rest;
ENDLOOP;
RETURN[tTable];
EXITS
earlyEnd => ERROR Error[SyntaxError, "Truth table ends early."];
longTerm => ERROR Error[SyntaxError, "Product term is too long."];
shortTerm => ERROR Error[SyntaxError, "Product term is too short."];
directive => ERROR Error[SyntaxError, "Could not understand one of the '.' directives."];
END;
END.