aland/huffman.lisp
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cleanup - remove debugging messages

Browse source
This commit is contained in:
Alan Daniels 2026-01-26 18:24:59 +11:00
parent af938ba5ff
commit c079da575d
1 changed files with 3 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

10
huffman.lisp
View file

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