EncodeStates: 
PUBLIC 
PROC[fsm: FSMData] = {
Mod: PROC[r1, r2, r3, r4: IO.ROPE ← NIL] = {firstMod ← FALSE; RETURN};
Mod: PROC[r1, r2, r3, r4: IO.ROPE ← NIL] = { -- Verbose
IF NOT trace THEN {firstMod ← FALSE; RETURN};
IF firstMod THEN {
log.PutF["\nThe state expressions in %g are being\n", IO.rope[fsm.name]];
log.PutRope["  firstMod to insure that all states are mutually exclusive.\n"]};
 
log.PutRope[Rope.Cat[r1, r2, r3, r4]]; firstMod ← FALSE};
 
varOuts:   Bits ← NEW[BitArray ← ALL[FALSE]];
stateOuts:   Bits ← NEW[BitArray ← ALL[FALSE]];
statePats:   StatePatterns    ← NIL;
statePatSets:  StatePatternSets   ← NIL;
groups:   Groups     ← NIL;
log:    IO.STREAM    ← TerminalIO.TOS[];
firstMod:   BOOL      ← TRUE;
firstXtra:   INT      ← 0;
maxStNmLgth: INT      ← 0;
xtraCnts:   ARRAY [0..20) OF NAT ← ALL[0];
xtraOrder:  ARRAY [0..20) OF NAT ← ALL[0];
maxXtraCnt:  NAT ← 0;
outTab:   SymTab.Ref    ← SymTab.Create[];
outTabIndex:  INT      ← 0;
OutIndex: 
PROC[out: 
IO.
ROPE] 
RETURNS[index: 
INT] = {
refInt: REF INT ← NARROW[SymTab.Fetch[outTab, out].val];
IF refInt=
NIL 
THEN {
IF ~fsm.outInAll AND ~RopeList.Memb[fsm.outIns, out] THEN RETURN[-1];
refInt ← NEW[INT←outTabIndex];
outTabIndex ← outTabIndex+1;
[]←SymTab.Store[outTab, out, refInt]};
 
RETURN[refInt^]};
 
IndexOut: 
PROC[index: 
INT] 
RETURNS[out: 
IO.
ROPE] = {
Find: SymTab.EachPairAction =
{IF index=NARROW[val, REF INT]^ THEN {out←key; RETURN[TRUE]}};
 
IF NOT SymTab.Pairs[outTab, Find] THEN ERROR};
 
allOuts: ROPES;
IF NOT trace THEN log.PutF["Encoding %g states ... ", IO.rope[fsm.name]];
IF trace THEN log.PutRope["Cross link InTransitions\n"];
CrossLinkTransitions[fsm];
IF trace THEN log.PutRope["Register sorted outs\n"];
FOR states: States ← fsm.states, states.rest 
WHILE states#
NIL 
DO
FOR outs: 
ROPES ← states.first.outputs, outs.rest 
WHILE outs#
NIL 
DO
allOuts ← CONS[outs.first, allOuts] ENDLOOP;
 
FOR trans: Transitions ← states.first.outTrans, trans.rest 
WHILE trans#
NIL 
DO
FOR outs: 
ROPES ← trans.first.outputs, outs.rest 
WHILE outs#
NIL 
DO
allOuts ← CONS[outs.first, allOuts] ENDLOOP ENDLOOP ENDLOOP;
 
 
 
FOR outs: 
ROPES ← Sort[allOuts], outs.rest 
WHILE outs#
NIL 
DO
IF OutIndex[outs.first]#-1 
AND IsXtra[outs.first] 
THEN {
ii: INT ← Convert.IntFromRope[outs.first.Substr[4]];
IF 
trace 
AND (ii+1)>firstXtra
THEN log.PutF["First extra state index set to: %g\n", IO.int[ii+1]];
 
firstXtra ← MAX[ii+1, firstXtra]} ENDLOOP;
 
 
IncludeStateOutputsInTransitions[fsm];
IF trace THEN log.PutRope["Fill in State Patterns\n"];
FOR states: States ← fsm.states, states.rest 
WHILE states#
NIL 
DO
TwoBits: TYPE = RECORD[ones, zeros: LIST OF Bits];
list:  LIST OF TwoBits ← NIL;
first:  BOOL ← TRUE;
stp:  StatePattern ← [
states.first,
NEW[BitArray←ALL[FALSE]],
NEW[BitArray←ALL[FALSE]],
NEW[BitArray←ALL[FALSE]],
NEW[BitArray←ALL[FALSE]]];
FOR outs: 
ROPES ← states.first.outputsInv, outs.rest 
WHILE outs#
NIL 
DO
index: INT ← OutIndex[outs.first];
IF index = -1 THEN ERROR;
stp.zeros[index] ← TRUE ENDLOOP;
 
FOR trans: Transitions ← states.first.inTrans, trans.rest 
WHILE trans#
NIL 
DO
ones: BitArray ← ALL[FALSE];
FOR outs: 
ROPES ← trans.first.outputs, outs.rest 
WHILE outs#
NIL 
DO
index: INT ← OutIndex[outs.first]; IF index#-1 THEN ones[index] ← TRUE;
ENDLOOP;
 
FOR out: 
INT 
IN [0..outTabIndex) 
DO
IF first THEN stp.ones[out] ← ones[out];
IF ones[out] AND stp.zeros[out] THEN ERROR;
stateOuts[out] ← stateOuts[out] OR ones[out];
IF ones[out] # stp.ones[out] 
THEN {
varOuts[out]  ← TRUE;
stp.locVar[out] ← TRUE; -- not consistantly true in this state
stp.ones[out]  ← FALSE};
 
ENDLOOP;
 
first ← FALSE ENDLOOP;
 
statePats ← CONS[stp, statePats] ENDLOOP;
 
IF trace THEN log.PutRope["Fixup consistant state outputs\n"];
FOR out: 
INT 
IN [0..outTabIndex) 
DO
stateOuts[out] ← stateOuts[out] AND NOT varOuts[out] ENDLOOP;
 
IF trace THEN log.PutRope["Build main pattern sets\n"];
FOR stps: StatePatterns ← statePats, stps.rest 
WHILE stps#
NIL 
DO
stp:  StatePattern ← stps.first;
stp.state.outputsInv ← NIL;
stp.state.outputs  ← NIL;
maxStNmLgth ← MAX[maxStNmLgth, stp.state.name.Length[]];
FOR out: 
INT 
IN [0..outTabIndex) 
DO
IF stp.ones[out] 
AND 
NOT stateOuts[out] 
THEN {
stp.locOne[out] ← TRUE; -- always true in this state but flakey in some others
stp.ones[out]  ← FALSE};
 
IF stp.zeros[out] AND NOT stateOuts[out] THEN ERROR;
IF stp.zeros[out] THEN stp.state.outputsInv ← CONS[IndexOut[out], stp.state.outputsInv];
IF stp.ones[out] THEN stp.state.outputs   ← CONS[IndexOut[out], stp.state.outputs];
ENDLOOP;
 
FOR ss: StatePatternSets ← statePatSets, ss.rest 
WHILE ss#
NIL 
DO
IF stp.ones^ = ss.first.first.ones^ THEN {ss.first ← CONS[stp, ss.first]; EXIT};
REPEAT FINISHED => statePatSets ← CONS[LIST[stp], statePatSets] ENDLOOP;
 
ENDLOOP;
 
Display results for debugging
IF trace 
THEN {
other: ROPES;
states: ROPES;
vars: ROPES;
FOR out: 
INT 
IN [0..outTabIndex) 
DO
IF varOuts[out]
THEN vars ← CONS[IndexOut[out], vars]
ELSE 
IF stateOuts[out]
THEN states ← CONS[IndexOut[out], states]
ELSE other ← CONS[IndexOut[out], other] ENDLOOP;
 
 
 
PrintList["State Outputs",  Sort[states], log];
PrintList["Variable Outputs", Sort[vars], log];
PrintList["Other Outputs",  Sort[other], log];
FOR ss: 
StatePatternSets ← statePatSets, ss.rest 
WHILE ss#
NIL 
DO
log.PutRope["\n"];
FOR s: StatePatterns ← ss.first, s.rest 
WHILE s#
NIL 
DO
PrintStatePattern[s.first, maxStNmLgth, outTabIndex, log] ENDLOOP;
 
ENDLOOP;
 
log.PutRope["\n"]};
 
Second Level Stuff
At this point, each statePatSet is differenciable from every other set using only consistant state outputs.  We will now break up each of these sets into subsets corresponding to unique t patterns.  Care is taken to segregate states which have any variable outputs into a separate group of subsets where the legal t patterns are filtered by the union of all the variable outputs in the group of variable subsets.  Before this last partitioning occurs though, we try to throw out variable patterned states which are individually distinguishable.
IF trace THEN log.PutRope["Partition each main set into groups\n"];
FOR main: 
StatePatternSets ← statePatSets, main.rest 
WHILE main#
NIL 
DO
grp:    Group;
variants:   StatePatterns;
varsNonUnique: StatePatterns;
varsUnique:  StatePatterns;
mask:    Bits ← NEW[BitArray ← ALL[FALSE]];
Build subsets for non-variant states and collect variant states;
FOR s: StatePatterns ← main.first, s.rest 
WHILE s#
NIL 
DO
stp:  StatePattern ← s.first;
IF stp.locVar^ # emptyArray^
THEN variants ← CONS[stp, variants]
ELSE FOR ss: 
StatePatternSets ← grp.conSets, ss.rest 
WHILE ss#
NIL 
DO
IF (~useLocOnes 
OR stp.locOne^ = ss.first.first.locOne^)
THEN {ss.first ← CONS[stp, ss.first]; EXIT};
 
REPEAT FINISHED => grp.conSets ← CONS[LIST[stp], grp.conSets] ENDLOOP;
 
 
ENDLOOP;
 
Now try to find unique variants
FOR gv: StatePatterns ← variants, gv.rest 
WHILE gv#
NIL 
DO
FOR sub: StatePatternSets ← grp.conSets, sub.rest 
WHILE sub#
NIL 
DO
IF ComparePatterns[useLocOnes, gv.first, sub.first.first, outTabIndex].comp = indistinct
THEN {varsNonUnique ← CONS[gv.first, varsNonUnique]; GOTO Loop};
 
REPEAT Loop => LOOP ENDLOOP;
 
FOR otherGV: StatePatterns ← variants, otherGV.rest 
WHILE otherGV#
NIL 
DO
IF otherGV.first.state # gv.first.state
AND ComparePatterns[useLocOnes, gv.first, otherGV.first, outTabIndex].comp = indistinct
THEN {varsNonUnique ← CONS[gv.first, varsNonUnique]; EXIT};
 
 
REPEAT FINISHED => varsUnique ← CONS[gv.first, varsUnique] ENDLOOP;
 
ENDLOOP;
 
Accumulate variant outputs into mask
FOR gv: StatePatterns ← varsNonUnique, gv.rest 
WHILE gv#
NIL 
DO
FOR out: 
INT 
IN [0..outTabIndex) 
DO
mask[out] ← mask[out] OR gv.first.locVar[out] ENDLOOP ENDLOOP;
 
 
Insert variant PatternState into variant subsets
FOR gv: StatePatterns ← varsNonUnique, gv.rest 
WHILE gv#
NIL 
DO
stp:  StatePattern ← gv.first;
FOR ss: StatePatternSets ← grp.varSets, ss.rest 
WHILE ss#
NIL 
DO
IF ComparePatterns[useLocOnes, gv.first, ss.first.first, outTabIndex, mask].comp= indistinct
THEN {ss.first ← CONS[stp, ss.first]; EXIT};
 
REPEAT FINISHED => grp.varSets ← CONS[LIST[stp], grp.varSets] ENDLOOP;
 
ENDLOOP;
 
Add uniques to grp varients as one element sets (just for completeness)
FOR gv: StatePatterns ← varsUnique, gv.rest 
WHILE gv#
NIL 
DO
grp.varSets ← CONS[LIST[gv.first], grp.varSets] ENDLOOP;
 
groups ← CONS[grp, groups];
ENDLOOP;
 
IF trace THEN log.PutRope["Calc max group cnts and overall max cnt\n"];
FOR grps: Groups ← groups, grps.rest 
WHILE grps#
NIL 
DO
bias: NAT  ← 0;
grps.first.maxCnt ← 0;
FOR ss: StatePatternSets ← grps.first.conSets, ss.rest 
WHILE ss#
NIL 
DO
grps.first.maxCnt ←
MAX[grps.first.maxCnt, GetSizeIndex[useLocOnes, ss.first].size] ENDLOOP;
 
bias ← grps.first.maxCnt;
IF bias>0 THEN bias← BitOps.TwoToThe[NBits[bias]];
FOR ss: StatePatternSets ← grps.first.varSets, ss.rest 
WHILE ss#
NIL 
DO
grps.first.maxCnt ←
MAX[grps.first.maxCnt, bias+GetSizeIndex[useLocOnes, ss.first, bias>0].size]
ENDLOOP;
 
maxXtraCnt ← MAX[maxXtraCnt, grps.first.maxCnt];
ENDLOOP;
 
Just get the xtra bits registered in order
FOR bit: 
INT 
IN [0..NBits[maxXtraCnt]) 
DO
stateBitNm: IO.ROPE ← IO.PutFR["%g%g", IO.rope[xtraNm], IO.int[firstXtra+bit]];
[]←OutIndex[stateBitNm] ENDLOOP; 
 
IF trace THEN log.PutF[" Max Xtra Cnt: %g\n", IO.int[maxXtraCnt]];
IF trace THEN log.PutRope["Sort groups and their sets by decreasing size\n"];
DO
TwoGroups: TYPE = RECORD[g0, g1: Group];
done: BOOL ← TRUE;
FOR grps: Groups ← groups, grps.rest 
WHILE grps#
NIL 
AND grps.rest#
NIL 
DO
IF grps.first.maxCnt < grps.rest.first.maxCnt 
THEN {
[grps.first, grps.rest.first] ← TwoGroups[grps.rest.first, grps.first];
done ← FALSE};
 
ENDLOOP;
 
IF done THEN EXIT ENDLOOP;
 
FOR grps: Groups ← groups, grps.rest 
WHILE grps#
NIL 
AND grps.rest#
NIL 
DO
TwoSPs: TYPE = RECORD[g0, g1: StatePatterns];
DO
done: BOOL ← TRUE;
FOR ss: StatePatternSets ← grps.first.conSets, ss.rest 
WHILE ss#
NIL 
AND ss.rest#
NIL 
DO
IF GetSizeIndex[useLocOnes, ss.first].size < GetSizeIndex[useLocOnes, ss.rest.first].size
THEN {[ss.first, ss.rest.first] ← TwoSPs[ss.rest.first, ss.first]; done ← FALSE};
 
ENDLOOP;
 
IF done THEN EXIT ENDLOOP;
 
DO
done: BOOL ← TRUE;
FOR ss: StatePatternSets ← grps.first.varSets, ss.rest 
WHILE ss#
NIL 
AND ss.rest#
NIL 
DO
IF GetSizeIndex[useLocOnes, ss.first].size < GetSizeIndex[useLocOnes, ss.rest.first].size
THEN {[ss.first, ss.rest.first] ← TwoSPs[ss.rest.first, ss.first]; done ← FALSE};
 
ENDLOOP;
 
IF done THEN EXIT ENDLOOP;
 
ENDLOOP;
 
IF trace THEN log.PutRope["Assign Xtra State bits\n"];
FOR bit: INT IN [0..20) DO xtraOrder[bit] ← bit ENDLOOP;
FOR grps: Groups ← groups, grps.rest 
WHILE grps#
NIL 
DO
ReOrderXtras: 
PROC[biasBit: 
INT ← -1] = { -- biasBit is last
DO
done:  BOOL ← TRUE;
TwoBits: TYPE = RECORD[b0, b1: NAT];
FOR bit: 
INT 
IN [1..NBits[maxXtraCnt]) 
DO
i1: INT ← xtraOrder[bit-1];
i2: INT ← xtraOrder[bit];
IF i1=biasBit 
OR i2#biasBit 
AND (xtraCnts[i1] > xtraCnts[i2])
 THEN {
[xtraOrder[bit-1], xtraOrder[bit]] ← TwoBits
[xtraOrder[bit], xtraOrder[bit-1]];
done ← FALSE} ENDLOOP;
 
 
IF done THEN EXIT ENDLOOP};
 
 
MakeAssignments: 
PROC[stps: StatePatterns, size, index: 
NAT, biasIt: 
BOOL] = {
FOR s: StatePatterns ← stps, s.rest 
WHILE s#
NIL 
DO
AddBit: 
PROC[idx: 
INT] = {
stateBitNm: IO.ROPE ← IO.PutFR["%g%g", IO.rope[xtraNm], IO.int[firstXtra+idx]];
FOR lst: Transitions ← stp.state.inTrans, lst.rest 
WHILE lst#
NIL 
DO
xtraCnts[idx] ← xtraCnts[idx] + 1 ENDLOOP; -- times it will prob be used
 
IF ~fsm.outInAll 
AND ~RopeList.Memb[fsm.outIns, stateBitNm]
 THEN fsm.outIns ← CONS[stateBitNm, fsm.outIns];
 
stp.state.outputs ← CONS[stateBitNm, stp.state.outputs];
stp.ones[OutIndex[stateBitNm]] ← TRUE;
Mod[" Adding output ", stateBitNm, " to state ", stp.state.name.Cat[".\n"]]};
 
stp:   StatePattern ← s.first;
numb:  INT ← index;
index  ← index+1;
IF biasIt THEN AddBit[biasBit];
FOR bit: 
INT 
IN [0..NBits[size]) 
DO
IF (numb MOD 2)=1 THEN AddBit[xtraOrder[bit]];
numb ← numb/2 ENDLOOP;
 
ENDLOOP};
 
 
size, index: NAT ← 0;
biasBitIndex: INT ← MAX[0, NBits[maxXtraCnt]-2]; -- pick next to last
biasBit:  INT ← xtraOrder[biasBitIndex];
ReOrderXtras[biasBit];
IF trace THEN log.PutF["Bias bit: %g\n", IO.int[biasBit]];
Do non-variant state assignments;
FOR ss: StatePatternSets ← grps.first.conSets, ss.rest 
WHILE ss#
NIL 
DO
[size, index] ← GetSizeIndex[useLocOnes, ss.first];
MakeAssignments[ss.first, size, index, FALSE];
IF ~trace THEN LOOP;
TerminalIO.PutRope["\n"];
FOR s: StatePatterns ← ss.first, s.rest 
WHILE s#
NIL 
DO
PrintStatePattern[s.first, maxStNmLgth, outTabIndex, log] ENDLOOP;
 
ReOrderXtras[biasBit] ENDLOOP;
 
Do variant state assignments;
FOR ss: StatePatternSets ← grps.first.varSets, ss.rest 
WHILE ss#
NIL 
DO
[size, index] ← GetSizeIndex[useLocOnes, ss.first, grps.first.conSets#NIL];
MakeAssignments[ss.first, size, index, grps.first.conSets#NIL];
IF ~trace THEN LOOP;
TerminalIO.PutRope["\n"];
FOR s: StatePatterns ← ss.first, s.rest 
WHILE s#
NIL 
DO
PrintStatePattern[s.first, maxStNmLgth, outTabIndex, log];
ENDLOOP;
 
ReOrderXtras[biasBit] ENDLOOP;
 
ReOrderXtras[-1];
IF trace THEN TerminalIO.PutRope["\n"];
ENDLOOP;
 
IF trace THEN log.PutRope["Check pairs and add inverted bits\n"];
FOR test1: StatePatterns ← statePats, test1.rest 
WHILE test1#
NIL 
DO
FOR test2: StatePatterns ← test1.rest, test2.rest 
WHILE test2#
NIL 
DO
comp:  StatePatternComp;
loc:  INT ← -1;
bitNm: IO.ROPE;
smSp:  StatePattern; 
lrgSp:  StatePattern; 
[comp, loc] ← ComparePatterns[useLocOnes, test1.first, test2.first, outTabIndex];
IF comp=indistinct THEN ERROR;
bitNm ← IndexOut[loc];
smSp ← IF comp=aLrg THEN test2.first ELSE test1.first;
lrgSp ← IF comp=aLrg THEN test1.first ELSE test2.first;
IF 
NOT RopeList.Memb[smSp.state.outputsInv, bitNm]
THEN smSp.state.outputsInv ← CONS[bitNm, smSp.state.outputsInv];
 
IF 
NOT RopeList.Memb[lrgSp.state.outputs, bitNm]
THEN lrgSp.state.outputs  ← CONS[bitNm, lrgSp.state.outputs];
 
smSp.zeros[loc] ← TRUE;
Mod[" Adding ~", bitNm, " to state ",
smSp.state.name.Cat[" to exclude ", lrgSp.state.name, ".\n"]];
ENDLOOP;
 
ENDLOOP;
 
RemoveStateOutputsFromInTransitions[fsm];
IF trace THEN log.PutRope["Sort statePats by state name\n"];
DO
TwoStatePatterns: TYPE = RECORD[s1, s2: StatePattern];
done:     BOOL ← TRUE;
FOR sps: StatePatterns ← statePats, sps.rest 
WHILE sps#
NIL 
AND sps.rest#
NIL 
DO
IF Rope.Compare[sps.first.state.name, sps.rest.first.state.name] = greater 
THEN
{[sps.first, sps.rest.first] ← TwoStatePatterns[sps.rest.first, sps.first]; done ← FALSE}
 
ENDLOOP;
 
IF done THEN EXIT ENDLOOP;
 
Print new State specifications.
IF 
NOT trace 
THEN {
IF firstMod
THEN log.PutRope["done - state definitions unchanged\n"]
ELSE log.PutRope["done - state definitions changed\n"];
 
RETURN};
 
log.PutF["\nSummary of state specificatons for %g: \n\n", IO.rope[fsm.name]];
FOR sps: StatePatterns ← statePats, sps.rest 
WHILE sps#
NIL 
DO
sps.first.state.outputs  ← Sort[sps.first.state.outputs];
sps.first.state.outputsInv ← Sort[sps.first.state.outputsInv];
log.PutF["%g\n", IO.rope[sps.first.state.name]];
FOR outs: 
ROPES ← sps.first.state.outputs, outs.rest 
WHILE outs#
NIL 
DO
log.PutF[" %g\n", IO.rope[outs.first]]; ENDLOOP;
 
FOR outs: 
ROPES ← sps.first.state.outputsInv, outs.rest 
WHILE outs#
NIL 
DO
log.PutF[" ~%g\n", IO.rope[outs.first]]; ENDLOOP ENDLOOP;
 
 
FOR sps: StatePatterns ← statePats, sps.rest 
WHILE sps#
NIL 
DO
PrintStatePattern[sps.first, maxStNmLgth, outTabIndex, log] ENDLOOP;
 
log.PutRope["Outputs:\n"];
FOR out: 
INT 
IN [0..outTabIndex) 
DO
log.PutF["%4g:  %g\n", IO.int[out], IO.rope[IndexOut[out]]] ENDLOOP;
 
log.PutChar[IO.CR]};