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
Bertrand Serlet May 27, 1986 3:17:13 pm PDT
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.ROPE ← NIL,
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: BOOL ← FALSE;
[ , 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.STREAM ← IO.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: BOOL ← FALSE;
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.ROPE ← NIL;
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: BOOL ← FALSE;
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
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
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: BOOL ← FALSE;
eof: BOOL ← FALSE;
-- 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: BOOL ← FALSE;
eof: BOOL ← FALSE;
GetInt:
PROC [r: Rope.
ROPE, pos:
INT]
RETURNS [
INT] =
BEGIN
i: INT;
bad: BOOL ← FALSE;
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: BOOL ← FALSE;
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] = '.
OR 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;
}
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.