DIRECTORY Ascii, CodeB, IO, RefText, Rope; CodeBImpl: CEDAR PROGRAM IMPORTS Ascii, IO, RefText, Rope EXPORTS CodeB = {OPEN CodeB; StringNotInAlphabet: PUBLIC ERROR [s: ROPE, L: Language] = CODE; Code: TYPE = REF CodePrivate; CodePrivate: PUBLIC TYPE = RECORD [ membership: Membership, y, f: CHAR, q: SubstitutionFunction, B: DecisionTree _ NIL, frope: ROPE ]; DecisionTree: TYPE = REF DecisionTreePrivate; DecisionTreePrivate: TYPE = RECORD [ variant: SELECT kind: * FROM branch => [a: ARRAY CHAR OF DecisionTree _ ALL[NIL]], leaf => [c: CHAR], ENDCASE]; Branch: TYPE = REF DecisionTreePrivate[branch]; Leaf: TYPE = REF DecisionTreePrivate[leaf]; CharClass: TYPE = {None, S2, S12, S1, S01, S0}; CreateCode: PUBLIC PROC [membership: Membership, y, f: CHAR, q: SubstitutionFunction] RETURNS [code: Code] = { code _ NEW [CodePrivate _ [ membership: membership, y: y, f: f, q: q, frope: Rope.FromChar[f]]]; FOR c: CHAR IN CHAR DO IF CharIn[c, S01, code] THEN code.B _ DTAdd[code.B, c, q[c]]; ENDLOOP; code _ code; }; DTAdd: PROC [old: DecisionTree, c: CHAR, path: ROPE] RETURNS [new: DecisionTree] = { SELECT path.Length[] FROM =0 => { IF old # NIL THEN ERROR; new _ NEW [DecisionTreePrivate[leaf] _ [leaf[c]]]; }; >0 => { br: Branch _ IF old # NIL THEN NARROW[old] ELSE NEW [DecisionTreePrivate[branch] _ [branch[]]]; c0: CHAR = path.Fetch[0]; br.a[c0] _ DTAdd[br.a[c0], c, path.Substr[start: 1]]; new _ br; }; ENDCASE => ERROR; new _ new; }; Encode: PUBLIC PROC [code: Code, sl: ROPE] RETURNS [ss: ROPE] = { sm: ROPE; FOR i: INT IN [0 .. sl.Length[]) DO IF NOT CharIn[sl.Fetch[i], S0, code] THEN ERROR StringNotInAlphabet[sl, Ll]; ENDLOOP; sm _ Shrink[code, sl]; ss _ Initialize[code, sm]; }; Decode: PUBLIC PROC [code: Code, ss: ROPE] RETURNS [sl: ROPE] = { sm: ROPE; IF NOT CharIn[ss.Fetch[0], S2, code] THEN ERROR StringNotInAlphabet[ss, Ls]; FOR i: INT IN [1 .. ss.Length[]) DO IF NOT CharIn[ss.Fetch[i], S1, code] THEN ERROR StringNotInAlphabet[ss, Ls]; ENDLOOP; sm _ UnInitialize[code, ss]; sl _ UnShrink[code, sm]; }; Shrink: PROC [code: Code, sl: ROPE] RETURNS [sm: ROPE] = { OPEN code; buff: REF TEXT _ RefText.New[10]; AddChar: PROC [c: CHAR, times: NAT _ 1] = { buff _ RefText.InlineReserveChars[buff, times]; THROUGH [1 .. times] DO buff _ RefText.InlineAppendChar[buff, c] ENDLOOP; }; AddRope: PROC [r: ROPE] = { buff _ RefText.InlineReserveChars[buff, r.Length[]]; buff _ RefText.AppendRope[buff, r]; }; start: INT _ 0; lLen: INT = sl.Length[]; WHILE start < lLen DO nony, next: INT _ start; Addys: PROC [coeff, offset: NAT] = { AddChar[y, coeff*(nony - start) + offset]; }; c: CHAR; WHILE nony < lLen AND (c _ sl.Fetch[nony]) = y DO nony _ nony + 1 ENDLOOP; IF nony = lLen THEN {Addys[1, 0]; EXIT}; IF CharIn[c, S01, code] THEN {Addys[2, 1]; AddRope[q[c]]; next _ nony + 1} ELSE { found: BOOL; [found, next] _ DTLookup[B, sl, nony]; IF found THEN Addys[2, 0] ELSE { Addys[1, 0]; DO IF next >= lLen THEN EXIT; c _ sl.Fetch[next]; IF CharIn[c, S01, code] OR c=y THEN EXIT; next _ next + 1; ENDLOOP; c _ c; }; AddRope[sl.Substr[start: nony, len: next-nony]]; }; start _ next; ENDLOOP; sm _ Rope.FromRefText[buff]; }; UnShrink: PROC [code: Code, sm: ROPE] RETURNS [sl: ROPE] = { OPEN code; buff: REF TEXT _ RefText.New[10]; AddChar: PROC [c: CHAR, times: NAT _ 1] = { buff _ RefText.InlineReserveChars[buff, times]; THROUGH [1 .. times] DO buff _ RefText.InlineAppendChar[buff, c] ENDLOOP; }; AddRope: PROC [r: ROPE] = { buff _ RefText.InlineReserveChars[buff, r.Length[]]; buff _ RefText.AppendRope[buff, r]; }; start: INT _ 0; mLen: INT = sm.Length[]; WHILE start < mLen DO nony, next, n: INT _ start; Addys: PROC [coeff, offset: NAT] = { AddChar[y, (n - offset)/coeff]; }; Addb: PROC = {AddRope[sm.Substr[start: nony, len: next - nony]]}; found: BOOL; c: CHAR; WHILE nony < mLen AND (c _ sm.Fetch[nony]) = y DO nony _ nony + 1 ENDLOOP; n _ nony - start; IF nony = mLen THEN {Addys[1, 0]; EXIT}; IF NOT CharIn[c, S1, code] THEN ERROR; [found, next, c] _ DTLookup[B, sm, nony]; SELECT TRUE FROM NOT found => { Addys[1, 0]; WHILE next < mLen AND sm.Fetch[next] # y DO next _ next + 1 ENDLOOP; Addb[]; }; n MOD 2 = 1 => {Addys[2, 1]; AddChar[c]}; ENDCASE => {Addys[2, 0]; Addb[]}; start _ next; ENDLOOP; sl _ Rope.FromRefText[buff]; }; DTLookup: PROC [dt: DecisionTree, path: ROPE, start: INT] RETURNS [found: BOOL, next: INT, c: CHAR] = { pathLen: INT = path.Length[]; next _ start; DO WITH dt SELECT FROM leaf: Leaf => RETURN [TRUE, next, leaf.c]; br: Branch => { ndt: DecisionTree; IF next = pathLen OR (ndt _ br.a[path.Fetch[next]]) = NIL THEN RETURN [FALSE, next, '?]; dt _ ndt; next _ next + 1; }; ENDCASE => ERROR; ENDLOOP; }; Initialize: PROC [code: Code, sm: ROPE] RETURNS [ss: ROPE] = { OPEN code; ss _ IF Verboten[sm, code] THEN frope.Concat[sm] ELSE sm; }; UnInitialize: PROC [code: Code, ss: ROPE] RETURNS [sm: ROPE] = { sm _ IF Verboten[ss, code] THEN ss.Substr[start: 1] ELSE ss; }; Verboten: PROC [s: ROPE, code: Code] RETURNS [b: BOOL] = { OPEN code; len: INT = s.Length[]; c: CHAR; i: INT _ 0; FOR i _ 0, i+1 WHILE i < len AND (c _ s.Fetch[i])=f DO NULL ENDLOOP; b _ i < len AND CharIn[c, S12, code]; }; CharIn: PROC [c: CHAR, class: CharClass, code: Code] RETURNS [in: BOOL] = INLINE { in _ SELECT class FROM None => code.membership[c] = None, S2 => code.membership[c] = S2, S12 => code.membership[c] = S1, S1 => SELECT code.membership[c] FROM S2, S1 => TRUE, S0, None => FALSE, ENDCASE => ERROR, S01 => code.membership[c] = S0, S0 => SELECT code.membership[c] FROM S2, S1, S0 => TRUE, None => FALSE, ENDCASE => ERROR, ENDCASE => ERROR; }; Lowercase: PUBLIC PROC [r: ROPE] RETURNS [lr: ROPE] = { i: INT _ -1; Generate: PROC RETURNS [CHAR] = {RETURN [Ascii.Lower[r.Fetch[i _ i + 1]]]}; lr _ Rope.FromProc[r.Length[], Generate]; }; qOctal: SubstitutionFunction; Start: PROC = { FOR c: CHAR IN CHAR DO qOctal[c] _ IO.PutFR["%03g", [integer[c - 0C]]] ENDLOOP; }; Start[]; }. ~CodeBImpl.Mesa Copyright c 1986 by Xerox Corporation. All rights reserved. Spreitzer, January 20, 1986 2:22:57 pm PST Κ ό– "cedar" style˜code™Kšœ Οmœ1™Kšžœ˜ Kš ‘œžœ  ‘œžœ œ  ‘œžœ ‘œ˜9K˜—K˜š’ œžœ ‘œžœžœ ‘œžœ˜@Kš ‘œžœ  ‘œžœ ‘œžœ ‘œ˜