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,
s
l:
ROPE]
RETURNS [
s
s:
ROPE] = {
sm: ROPE;
FOR i:
INT
IN [0 ..
s
l.Length[])
DO
IF
NOT CharIn[
s
l.Fetch[i],
S
0, code]
THEN ERROR StringNotInAlphabet[sl, Ll];
ENDLOOP;
sm ← Shrink[code, sl];
ss ← Initialize[code, sm];
};
Decode:
PUBLIC
PROC [code: Code,
s
s:
ROPE]
RETURNS [
s
l:
ROPE] = {
sm: ROPE;
IF
NOT CharIn[
s
s.Fetch[0],
S
2, code]
THEN ERROR StringNotInAlphabet[ss, Ls];
FOR i:
INT
IN [1 ..
s
s.Length[])
DO
IF
NOT CharIn[
s
s.Fetch[i],
S
1, code]
THEN ERROR StringNotInAlphabet[ss, Ls];
ENDLOOP;
sm ← UnInitialize[code, ss];
sl ← UnShrink[code, sm];
};
Shrink:
PROC [code: Code,
s
l:
ROPE]
RETURNS [
s
m:
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;
Add
ys:
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,
S
01, 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,
s
m:
ROPE]
RETURNS [
s
l:
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;
Add
ys:
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,
s
m:
ROPE]
RETURNS [
s
s:
ROPE] = {
OPEN code;
ss ← IF Verboten[sm, code] THEN frope.Concat[sm] ELSE sm;
};
UnInitialize:
PROC [code: Code,
s
s:
ROPE]
RETURNS [
s
m:
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,
S
1 =>
SELECT code.membership[c]
FROM
S2, S1 => TRUE,
S0, None => FALSE,
ENDCASE => ERROR,
S01 => code.membership[c] = S0,
S
0 =>
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[];
}.