cleanup - remove debugging messages

This commit is contained in:
Alan Daniels 2026-01-26 18:24:59 +11:00
parent af938ba5ff
commit c079da575d

View file

@ -28,6 +28,7 @@
(defun comp-interim (left right)
"sort interum nodes"
(< (car left) (car right)))
(defun freq2huffman (interim-nodes)
(loop
until (singlep interim-nodes)
@ -50,7 +51,7 @@
(setq code (ash code 1))))
(setq codelen ,codelen-form))
collect (cons ,key-form (cons code codelen)))))
(macroexpand '(mkcanon (for pair in sorted-huffman-list while pair) (car pair) (cdr (cdr pair))))
;; (macroexpand '(mkcanon (for pair in sorted-huffman-list while pair) (car pair) (cdr (cdr pair))))
(defun comp-huffman (left right)
"sort huffman mappings by code length & value"
@ -119,7 +120,6 @@
(when (> len 0)
(write-byte (- len 1) ,outstream)
(write-sequence (reverse buf) ,outstream)
(format t "~%wrote Block with ~d codes" len)
)
len))
@ -137,25 +137,21 @@
do (progn
(write-byte (car pair) outstream); write the key
(write-byte (cdr (cdr pair)) outstream); write the code-length
(bitstream-format (cdr pair))
(format t " <-- ~:C" (code-char (car pair)))
(setf (gethash (car pair) encoding-map) (cdr pair))
))
;; Writing the contents
(file-position instream :start)
(format t "~%wrote ~d blocks" (write-encoded-message encoding-map instream outstream))
(write-encoded-message encoding-map instream outstream)
)))
(defun decode (instream outstream)
(let ((canon (stream2canon instream))
(decoding-map (make-hash-table :test #'equal)))
(format t "~%Reading dictionary")
(loop for pair in canon
do (setf (gethash (cdr pair) decoding-map) (car pair)))
(loop for len = (read-byte instream nil nil)
while len
do (let ((source (cons 0 0)))
(format t "~%Expecting to see ~d codes" (+ len 1))
(write-sequence
(loop for k from 0 to len
collect (let ((sink (cons 0 0)))