-- TexHyph.mesa

-- last written by Doug Wyatt, November 10, 1979  5:51 PM

DIRECTORY
	TexDefs: FROM "TexDefs" USING[FChar],
	TexHyphDefs: FROM "TexHyphDefs",
	TexJustifyDefs: FROM "TexJustifyDefs",
	TexMemDefs: FROM "TexMemDefs",
	TexNodeDefs: FROM "TexNodeDefs" USING[MakeDiscNode, NodePtr],
	TexStringDefs: FROM "TexStringDefs" USING[AppendChar, AppendString],
	InlineDefs: FROM "InlineDefs" USING[BITAND, BITOR, BITSHIFT];

TexHyph: PROGRAM
IMPORTS TexHyphDefs,TexMemDefs,TexNodeDefs,TexStringDefs,InlineDefs
EXPORTS TexHyphDefs,TexJustifyDefs =
BEGIN OPEN TexHyphDefs;

XTable: POINTER TO ARRAY XIndex OF STRING _ NIL;
	-- ordered hash table
XHyph: POINTER TO ARRAY XIndex OF HyphBits _ NIL;
	-- companion hyphen position table

XInit: PROCEDURE =
BEGIN j: XIndex;
FOR j IN [0..XSize) DO XTable[j]_NIL; XHyph[j]_Zeros ENDLOOP;
END;


XLookup: PROCEDURE [s:STRING] RETURNS [intable:BOOLEAN, positions:HyphBits] =
BEGIN h: XIndex; t: STRING; comp: Comparison;
t_TexMemDefs.AllocString[s.length+1];
TexStringDefs.AppendString[t,s];
IF t.length<7 THEN TexStringDefs.AppendChar[t,' ];
DO h_XHash[t];
	WHILE (comp_XCompare[XTable[h],t])=greater DO
		h_h-1;
		IF h=0 THEN h_XSize-1;
		ENDLOOP;
	IF comp=equal THEN BEGIN intable_TRUE; positions_XHyph[h]; EXIT; END;
	IF s.length=7 THEN TexStringDefs.AppendChar[t,' ];
	IF t[t.length-2]#'s THEN BEGIN intable_FALSE; positions_Zeros; EXIT; END;
	t[t.length-2]_' ; 
	t.length_t.length-1;
	ENDLOOP;
TexMemDefs.FreeString[t];
END;

XEnt: PUBLIC PROCEDURE [s: STRING] =
BEGIN OPEN InlineDefs;
i,n: CARDINAL_0; c: CHARACTER; v,w: HyphBits_Zeros; t,j: STRING;
starseen: BOOLEAN_FALSE; comp: Comparison; h: XIndex;
t_TexMemDefs.AllocString[s.length+1];
FOR i IN [0..s.length) DO
	c_s[i];
	IF c='- THEN w_BITOR[w,1]
	ELSE IF c='* THEN starseen_TRUE
	ELSE BEGIN
		n_n+1; w_BITSHIFT[w,1];
		IF n<=7 OR starseen THEN TexStringDefs.AppendChar[t,c];
		starseen_FALSE;
		END;
	ENDLOOP;
IF n>16 THEN
	BEGIN
	END;
w_BITSHIFT[w,16-n];
IF n<7 THEN TexStringDefs.AppendChar[t,' ];
h_XHash[t];
WHILE t#NIL DO
	WHILE (comp_XCompare[XTable[h],t])=greater DO h_h-1 ENDLOOP;
	IF h=0 THEN h_XSize-1
	ELSE IF comp=equal THEN
		BEGIN
		ERROR;
		END
	ELSE BEGIN
		j_XTable[h]; v_XHyph[h];
		XTable[h]_t; XHyph[h]_w;
		t_j; w_v;
		END;
	ENDLOOP;
END;

XHash: PROCEDURE [s: STRING] RETURNS [XIndex] =
BEGIN i,acc: CARDINAL_0;
FOR i IN [0..MIN[6,s.length]) DO acc_7*acc+LOOPHOLE[s[i],INTEGER]; ENDLOOP;
RETURN[XSize-(acc MOD XSize)-1];
END;

XCompare: PROCEDURE [s,t: STRING] RETURNS [Comparison] =
BEGIN i: CARDINAL;
IF s=NIL THEN RETURN[less];
-- not necessary to test t.length since t cannot be NIL
FOR i IN [0..MIN[s.length, t.length])
	DO -- assume only lower-case letters
	IF s[i] < t[i] THEN RETURN[less];
	IF s[i] > t[i] THEN RETURN[greater];
	ENDLOOP;
RETURN [equal];
END;
(635)\428f1b7f0B139f1b1f0B159f1b5f0B100f1b7f0B628f1b4f0B790f1b5f0B183f1b8f0B48i1I5i1I12i1I121i1I3i35I34i1I20i1I16i1I9i1I15i1I4i
-- Data structures implementing sets of letters;

charSetTable: PUBLIC POINTER TO CharSetTable _ NIL;

InSet: PROCEDURE [c: CHARACTER, set: CharSetIndex] RETURNS [BOOLEAN] =
BEGIN OPEN InlineDefs;
IF o[c]<o['p] THEN
	RETURN[LOOPHOLE[BITSHIFT[charSetTable[set][0],o[c]],INTEGER]<0]
ELSE
	RETURN[LOOPHOLE[BITSHIFT[charSetTable[set][1],o[c]-o['p]],INTEGER]<0];
END;

o: PROCEDURE [c:CHARACTER] RETURNS [FiveBitChar] =
INLINE BEGIN
RETURN[InlineDefs.BITAND[LOOPHOLE[c,WORD],37B]];
END;


-- The suffix table;

suffixTable: PUBLIC POINTER TO SuffixTable_NIL;

SufGet: PROCEDURE [i: SufIndex] RETURNS [SufEntry] =
INLINE BEGIN
RETURN[suffixTable[i]];
END;

-- The prefix table;

prefixTable: PUBLIC POINTER TO PrefixTable_NIL;

PrefGet: PROCEDURE [i: PrefIndex] RETURNS [PrefEntry] =
INLINE BEGIN
RETURN[prefixTable[i]];
END;

-- The consonant pairs table

cpTable: PUBLIC POINTER TO CPTable_NIL;

CPGet: PROCEDURE [i: CPIndex] RETURNS [CPEntry] =
INLINE BEGIN
RETURN[cpTable[i]];
END;

Hyphenate: PUBLIC PROCEDURE
	[p: TexNodeDefs.NodePtr, n: CARDINAL, dhyphen: TexDefs.FChar] =
BEGIN i,j: CARDINAL; finale: CARDINAL_177777B; q: TexNodeDefs.NodePtr;
	exception,firsttime: BOOLEAN; hyphens: HyphBits; b,c,d,hyphchar: CHARACTER;
	sufpc: SufIndex; prefpc: PrefIndex; sufcode: SufInstr; prefcode: PrefInstr;
	t: PrefSufArgType; falsex: CARDINAL; se: SufEntry; pe: PrefEntry;

--Phase 0: Construct input-hyphen position word
n_MIN[n,MaxWL];
s[0]_s[n+1]_hyphchar_0C; --must be zero, so it looks like a vowel!
q_p; i_0;
UNTIL i=n DO
	WITH qq:q SELECT FROM
	kern => NULL;
	char =>	BEGIN s[i+1]_wc[i]_qq.c.char; i_i+1; END;
	ENDCASE => ERROR;
	q_q.link;
ENDLOOP;
s.length_n+2; wc.length_n;

--Phase 1: Search exception dictionary
[exception,hyphens]_XLookup[wc];
IF exception THEN
	BEGIN
	i_2;
	WHILE hyphens#0 DO
		IF hyphens>77777B THEN s[i]_hyphchar;
		hyphens_InlineDefs.BITSHIFT[hyphens,1]; i_i+1;
		ENDLOOP;
--DEBUG  WriteString["From exception table: "];
	END
ELSE BEGIN -- apply rules

--Phase 2: Remove suffixes
	i_n-1; firsttime_TRUE;
	WHILE i>=3 DO
		IF s[i+1]='e THEN finale_i+1
		ELSE IF finale=77776B THEN finale_i+2 ELSE finale_77777B;
		sufpc_o[s[i+1]];
		DO
			[sufcode,t,sufpc,falsex]_se_SufGet[sufpc];
			SELECT sufcode FROM
			scan =>	IF s[i]#t.c THEN sufpc_falsex ELSE i_i-1;
			double =>	IF s[i]#s[i-1] THEN sufpc_falsex ELSE i_i-1;
			table =>	IF ~InSet[s[i],t.s] THEN sufpc_falsex ELSE i_i-1;
			again =>	IF firsttime THEN BEGIN i_n-2; EXIT; END;
			check =>	IF i<=3 THEN sufpc_falsex;
			mark =>	IF t.i#0 OR firsttime THEN s[i+t.i+1]_hyphchar;
			ENDCASE => EXIT;
		ENDLOOP;
		SELECT sufcode FROM
		success =>	BEGIN s[i+t.i+1]_hyphchar; EXIT; END;
		fail =>	EXIT;
		repeat =>	BEGIN i_i+t.i-1; s[i+2]_hyphchar; END;
		efail =>	IF s[n]='d AND s[n-1]='e THEN 
						BEGIN i_n-3; finale_77776B; s[i+2]_hyphchar; END
					ELSE EXIT;
		ENDCASE;
		firsttime_FALSE;
	ENDLOOP;

--Phase 3: Remove prefixes
	prefpc_o[s[1]]; i_2; j_i-1;
	DO
		[prefcode,t,prefpc,falsex]_pe_PrefGet[prefpc];
		SELECT prefcode FROM
		scan =>	IF s[i]#t.c THEN prefpc_falsex ELSE i_i+1;
		repeat =>	IF s[i_i-t.i+1]=hyphchar THEN EXIT ELSE
							BEGIN prefpc_o[s[i-1]]; s[i-1]_hyphchar; j_i-1; END;
		ENDCASE =>	EXIT;
	ENDLOOP;
	SELECT prefcode FROM
	mark =>	IF t.i#0 THEN s[i-t.i]_hyphchar;
	table =>	IF ~InSet[s[i],t.s] THEN c_s[i_j] ELSE prefcode_mark;
	vow =>	c_s[i_i-1];
	cons =>	c_s[i];
	ENDCASE;

IF prefcode=mark THEN
	IF s[i+1]#hyphchar THEN BEGIN c_s[i]; s[i]_hyphchar END ELSE prefcode_fail;
 
IF prefcode#repeat AND prefcode#fail THEN
--Phase 4: Apply consonant pairs rules 
	DO -- c=s[i] at the top of the loop
		WHILE ~InSet [c,aeiouy0] DO c_s[i_i+1] ENDLOOP;
		WHILE InSet[s[i],aeiouy] DO i_i+1 ENDLOOP;
		IF (b_s[i])=hyphchar THEN EXIT;
		i_i+1; c_s[i];
		IF c='h AND (j_CPGet[o[b]].hchar)#0 THEN
			BEGIN b_b+j-2; c_s[i_i+1]; END;
		SELECT TRUE FROM
		b='q AND c='u => s[i-1]_hyphchar;
		b='c AND c='k => BEGIN c_s[i_i+1]; s[i]_hyphchar; END;
		InSet[c,aeiouy0] => LOOP;
		b=c =>
			SELECT TRUE FROM
			c#'l AND c#'s => s[i]_hyphchar;
			s[i+1]='e AND s[i+2]='r AND s[i+3]=hyphchar => EXIT;
			InSet[s[i+1],aeiouy] => s[i]_hyphchar;
			ENDCASE => LOOP;
		(IF s[(j_i)+1]='h AND (d_c+CPGet[o[c]].hchar-2)#c-2
				THEN c_s[i_i+1] ELSE d_c)=hyphchar => EXIT;
		~InSet[s[i+1],aeiouy] => LOOP; -- three consonants in a row
		~InSet[d,CPGet[o[b]].set] => s[j]_hyphchar;
		~InSet[d,CPGet[CPGet[o[b]].weak+26].set] => LOOP;
		s[i+1]='a AND s[i+2]='g AND finale=i+3 => EXIT;
		s[i+1]='e AND s[i+2]='s AND s[i+3]='t AND s[i+4]=hyphchar => EXIT;
		s[i+1]='e AND s[i+2]='r AND s[i+3]=hyphchar => EXIT;
		ENDCASE => s[i]_hyphchar;
	ENDLOOP;
	END; -- apply rules

--Phase 5: Insert hyphens (but don't isolate one char, or two at end)
q_p.link;
FOR i IN [3..n-2] DO
	WITH qq:q SELECT FROM
	kern => q_q.link;
	ENDCASE;
	IF finale ~IN [i..i+2] AND s[i]=hyphchar
		THEN BEGIN t: TexNodeDefs.NodePtr_TexNodeDefs.MakeDiscNode[dhyphen];
			t.link_q.link; q_q.link_t; 
			END;
	q_q.link;
	ENDLOOP;
END; -- of Hyphenate

s: STRING _ NIL;
wc: STRING _ NIL;

HyphInit: PROCEDURE =
	BEGIN OPEN TexMemDefs;
	XTable _ AllocMem[XSize];
	XHyph _ AllocMem[XSize];
	charSetTable _ AllocMem[SIZE[CharSetTable]];
	suffixTable _ AllocMem[SIZE[SuffixTable]];
	prefixTable _ AllocMem[SIZE[PrefixTable]];
	cpTable _ AllocMem[SIZE[CPTable]];
	s _ AllocString[MaxWL+2];
	wc _ AllocString[MaxWL];
	XInit;
	START TexHyphInit;
	END;

HyphInit;

END.
\103f1b5f0B255f1b2f0B190f1b6f0B161f1b7f0B163f1b5f0B84f1b9f0B