lang/occam/test/Huffman.ocm

   1 def
   2   bits.in.character     = 8,
   3   number.of.characters= 1 << bits.in.character,
   4   number.of.codes       = number.of.characters + 1,
   5   character.mask        = not ((not 0) << bits.in.character):
   6
   7 def
   8   root = 0, size.of.tree = (2* number.of.codes)-1, not.a.node = size.of.tree:
   9
  10 var
  11   escape, weight[size.of.tree],
  12   children[size.of.tree], parent[size.of.tree],
  13   character[size.of.tree], representative[number.of.characters] :
  14
  15 proc construct.tree =
  16   -- Create a tree for the encoding in which every character is escaped
  17   seq
  18     escape := root
  19     weight[escape] := 1
  20     children[escape] := root            -- it is a leaf
  21     seq ch= [0 for number.of.characters]
  22       representative[ch] := not.a.node                                  :
  23
  24 proc create.leaf(var new.leaf, value ch) =
  25   -- Extend the tree by fision of the escape leaf into two new leaves
  26   var new.escape:
  27   seq
  28     new.leaf            := escape + 1
  29     new.escape          := escape + 2
  30
  31     children[escape]    := new.leaf     -- escape is the new parent
  32
  33     weight[new.leaf]    := 0
  34     children[new.leaf]  := root
  35     parent[new.leaf]    := escape
  36     character[new.leaf] := ch
  37     representative[ch /\ character.mask] := new.leaf
  38
  39     weight[new.escape]  := 1
  40     children[new.escape]:= root
  41     parent[new.escape]  := escape
  42
  43     escape              := new.escape                                   :
  44
  45 proc swap.trees(value i, j) =
  46   -- Exchange disjoint sub-trees routed at i and j
  47   proc swap.words(var p,q) =
  48     -- Exchange values stored in p and q
  49     var t:
  50     seq
  51       t := p
  52       p := q
  53       q := t                                                            :
  54
  55   proc adjust.offspring(value i) =
  56     -- Restore downstream pointers to node i
  57     if
  58       children[i] = root
  59         representative[character[i] /\ character.mask] := i
  60       children[i] <> root
  61         seq child=[children[i] for 2]
  62           parent[child] := i                                            :
  63
  64   seq
  65     swap.words(children[i], children[j])
  66     swap.words(character[i], character[j])
  67     adjust.offspring(i)
  68     adjust.offspring(j)                                                 :
  69
  70 proc increment.frequency(value ch) =
  71   -- Adjust the weights of all relevant nodes to account for one more occurence
  72   -- of the character ch, and adjust the shape of the tree if necessary
  73   var node:
  74   seq
  75     if
  76       representative[ch /\ character.mask] <> not.a.node
  77         node := representative[ch /\ character.mask]
  78       representative[ch /\ character.mask] = not.a.node
  79         create.leaf(node, ch)
  80     while node <> root
  81       if
  82         weight[node-1] > weight[node]
  83           seq
  84             weight[node] := weight[node] + 1
  85             node := parent[node]
  86         weight[node-1] = weight[node]
  87           if i= [1 for (node-root)-1]
  88             weight[(node-i)-1] > weight[node]
  89               seq
  90                 swap.trees(node, node-i)
  91                 node := node-i
  92     weight[root] := weight[root] + 1                                    :
  93
  94 proc encode.character(chan output, value ch) =
  95   -- Transmit the encoding of ch along output
  96   def size.of.encoding = bits.in.character + (number.of.codes - 1) :
  97   var encoding[size.of.encoding], length, node:
  98   seq
  99     if
 100       representative[ch /\ character.mask] <> not.a.node
 101         seq
 102           length := 0
 103           node := representative[ch /\ character.mask]
 104       representative[ch /\ character.mask] = not.a.node
 105         seq
 106           seq i=[0 for bits.in.character]
 107             encoding[i] := (ch >> i) /\ 1       -- i'th bit of unencoded ch
 108           length := bits.in.character
 109           node := escape
 110     while node <> root
 111       seq
 112         encoding[length] := node - children[parent[node]]
 113         length := length + 1
 114         node := parent[node]
 115     seq i= [1 for length]
 116       output ! encoding[length-i]                                       :
 117
 118 proc decode.character(chan input, var ch) =
 119   -- Receive an encoding along input and store the corresponding character in ch
 120   var node:
 121   seq
 122     node := root
 123     while children[node] <> root
 124       var bit:
 125       seq
 126         input ? bit
 127         node := children[node] + bit
 128     if
 129       node < escape
 130         ch := character[node]
 131       node = escape
 132         var bit:
 133         seq
 134           input ? bit
 135           ch := -bit
 136           seq i= [2 for bits.in.character - 1]
 137             seq
 138               input ? bit
 139               ch := (ch << 1) \/ bit                                    :
 140
 141 def end.of.message = -1:
 142
 143 proc copy.encoding(chan source, sink) =
 144   -- Read a stream of characters from source, until signalled on end.of.source,
 145   -- and transmit their encodings in sequence along sink, followed by that of
 146   -- end.of.message, maintaining throughout the encoding tree for the encoding
 147   -- determined by the cumulative frequencies of the characters transmitted
 148   var more.characters.expected:
 149   seq
 150     construct.tree
 151     more.characters.expected := true
 152     while more.characters.expected
 153       var ch:
 154       seq
 155         source ? ch
 156         if
 157           ch <> end.of.message
 158             seq
 159               encode.character(sink, ch)
 160               increment.frequency(ch)
 161           ch = end.of.message
 162             more.characters.expected := false
 163     encode.character(sink, end.of.message)                              :
 164
 165 proc copy.decoding(chan source, sink) =
 166   -- Read the encodings of a stream of characters, up to and including the
 167   -- encoding of end.of.message, from source and transmit the corresponding
 168   -- characters along sink, maintaining the encoding tree for encoding
 169   -- determined by the cumulative frequencies of the characters received
 170   var more.characters.expected:
 171   seq
 172     construct.tree
 173     more.characters.expected := true
 174     while more.characters.expected
 175       var ch:
 176       seq
 177         decode.character(source, ch)
 178         if
 179           ch <> end.of.message
 180             seq
 181               sink ! ch
 182               increment.frequency(ch)
 183           ch = end.of.message
 184             more.characters.expected:=false                             :
 185
 186 var choose:
 187 seq
 188   input ? choose
 189   if
 190     choose='e'
 191       copy.encoding(input, output)
 192     choose='d'
 193       copy.decoding(input, output)