<> <> <> <> <> <> DIRECTORY BoolOps; BoolOpsImplB: CEDAR PROGRAM EXPORTS BoolOps = BEGIN OPEN BoolOps; ptermHashSize: INT = 5000; ptermArray: TYPE = ARRAY [0..ptermHashSize) OF LIST OF REF PTerm _ ALL[NIL]; ptermHashTab: TYPE = RECORD [ numEntries: INT _ 0, lengths: REF ptermArrayLengths _ NEW[ptermArrayLengths], vals: REF ptermArray _ NEW[ptermArray] ]; ptermArrayLengths: TYPE = ARRAY [0..ptermHashSize) OF NAT _ ALL[0]; pTermSeq: TYPE = REF pTermSeqRep _ NIL; pTermSeqRep: TYPE = RECORD [ pterms: SEQUENCE size: NAT OF REF PTerm ]; <<>> <> TTOptimize: PUBLIC PROC [tt: TruthTable] RETURNS [TruthTable] = BEGIN NewPTermSeq: PROC [ nTerms: NAT] RETURNS [ s: pTermSeq ] = { s _ NEW[pTermSeqRep[ nTerms ]] }; CopyPTerm: PROC [old: REF PTerm, size: CARDINAL] RETURNS [REF PTerm] = BEGIN new: REF PTerm _ NEW[PTerm[size]]; <<-- compiler bug: can't assign sequences (as in new _ NEW[PTerm[size] _ old^])>> FOR i: INT IN [0..size) DO new[i] _ old[i]; ENDLOOP; RETURN[new]; END; MergeOrOfDuplicateAndTerms: PROC [tt: TruthTable] RETURNS [TruthTable] = BEGIN tab: ptermHashTab; hash: INT; ins: CARDINAL ~ tt.numInputs; outs: CARDINAL ~ tt.numOutputs; newTt: TruthTable; <<-- hash each pterm into a bucket, combining terms if possible>> FOR i: INT IN [0..tt.numPTerms) DO deleteMe, addMe: REF PTerm _ NIL; term: REF PTerm ~ tt.pterms[i]; matched: BOOL; hash _ 0; FOR bit: INT IN [0 .. ins) DO hash _ hash * 3 + ORD[term[bit]]; ENDLOOP; hash _ ABS[hash] MOD ptermHashSize; <<-- do the input bits match an existing term?>> matched _ FALSE; FOR pt: LIST OF REF PTerm _ tab.vals[hash], pt.rest WHILE pt # NIL DO matched _ TRUE; FOR i: INT IN [0 .. ins) DO IF pt.first[i] # term[i] THEN matched _ FALSE; ENDLOOP; IF matched THEN { <<-- OR in the new term>> newList: LIST OF REF PTerm _ NIL; newTerm: REF PTerm _ CopyPTerm[pt.first, ins + outs]; FOR k: INT IN [ins .. ins + outs) DO IF term[k] = $One THEN newTerm[k] _ $One; ENDLOOP; FOR old: LIST OF REF PTerm _ tab.vals[hash], old.rest WHILE old # NIL DO IF old.first = pt.first THEN newList _ CONS[newTerm, newList] ELSE newList _ CONS[old.first, newList]; ENDLOOP; tab.vals[hash] _ newList; EXIT; }; ENDLOOP; IF ~matched THEN { <<-- can not be combined with existing term>> tab.vals[hash] _ CONS[term, tab.vals[hash]]; tab.numEntries _ tab.numEntries + 1; }; ENDLOOP; newTt _ NEW[TruthTableRec[tab.numEntries]]; newTt.numInputs _ ins; newTt.numOutputs _ outs; newTt.numPTerms _ 0; FOR i: INT IN [0..ptermHashSize) DO FOR pt: LIST OF REF PTerm _ tab.vals[i], pt.rest WHILE pt # NIL DO newTt.pterms[newTt.numPTerms] _ pt.first; newTt.numPTerms _ newTt.numPTerms + 1; ENDLOOP; ENDLOOP; IF newTt.numPTerms # tab.numEntries THEN ERROR; -- more items than indicated by h.numEntries RETURN[newTt]; END; MergeAndOfLikeOrTerms: PROC [tt: TruthTable] RETURNS [TruthTable] = BEGIN tab: ptermHashTab; hash: INT; ins: CARDINAL ~ tt.numInputs; outs: CARDINAL ~ tt.numOutputs; newTt: TruthTable; <<-- hash each pterm into a bucket based upon the output bits>> FOR i: INT IN [0..tt.numPTerms) DO term: REF PTerm ~ tt.pterms[i]; hash _ 0; FOR bit: INT IN [ins .. ins + outs) DO hash _ hash * 3 + ORD[term[bit]]; ENDLOOP; hash _ ABS[hash] MOD ptermHashSize; tab.vals[hash] _ CONS[term, tab.vals[hash]]; tab.lengths[hash] _ tab.lengths[hash] + 1; tab.numEntries _ tab.numEntries + 1; ENDLOOP; newTt _ NEW[TruthTableRec[tab.numEntries]]; newTt.numInputs _ ins; newTt.numOutputs _ outs; newTt.numPTerms _ 0; FOR i: INT IN [0..ptermHashSize) DO numPTermsThisBucket: NAT _ tab.lengths[i]; bucketPTerms: pTermSeq _ NewPTermSeq[ numPTermsThisBucket ]; <> bucketIndex: NAT _ 0; FOR pt: LIST OF REF PTerm _ tab.vals[i], pt.rest WHILE pt # NIL DO bucketPTerms[bucketIndex] _ pt.first; bucketIndex _ bucketIndex + 1; ENDLOOP; <> FOR pt1: NAT _ 0 , pt1+1 WHILE pt1 < numPTermsThisBucket DO pt2: INTEGER _ 0; WHILE pt2 < numPTermsThisBucket DO sameOuts: BOOL _ TRUE; differInBits: INT _ 0; differBit: INT; FOR bit: INT IN [ins .. ins + outs) DO IF bucketPTerms[pt1][bit] # bucketPTerms[pt2][bit] THEN { sameOuts _ FALSE; EXIT; }; ENDLOOP; IF sameOuts THEN { FOR bit: INT IN [0 .. ins) DO IF bucketPTerms[pt1][bit] # bucketPTerms[pt2][bit] THEN { differInBits _ differInBits + 1; differBit _ bit; }; ENDLOOP; IF differInBits = 1 THEN { <<-- remake the bucket, replacing bucketPTerms[pt1] with a combined term and removing bucketPTerms[pt2]>> bucketPTerms[pt1][differBit] _ $NC; FOR pt3: NAT IN [0..numPTermsThisBucket) DO IF pt3=pt2 THEN { numPTermsThisBucket _ numPTermsThisBucket -1; tab.numEntries _ tab.numEntries - 1; }; IF pt3 > pt2 THEN bucketPTerms[pt3-1] _ bucketPTerms[pt3]; ENDLOOP; pt2 _ -1; }; }; pt2 _ pt2 + 1; ENDLOOP; ENDLOOP; <<-- make the truth table>> FOR pt: NAT IN [0..numPTermsThisBucket) DO newTt.pterms[newTt.numPTerms] _ bucketPTerms[pt]; newTt.numPTerms _ newTt.numPTerms + 1; ENDLOOP; ENDLOOP; IF newTt.numPTerms # tab.numEntries THEN ERROR; -- differing # items than indicated by tab.numEntries RETURN[newTt]; END; lastNumPterms: INT; DO lastNumPterms _ tt.numPTerms; tt _ MergeOrOfDuplicateAndTerms[tt]; tt _ MergeAndOfLikeOrTerms[tt]; IF tt.numPTerms > lastNumPterms THEN ERROR; IF tt.numPTerms = lastNumPterms THEN EXIT; ENDLOOP; RETURN[tt]; END; END.