(uiop:define-package :binry-hop/util (:export #:make-rectified-polynomial #:bit-to-sign #:sign-to-bit #:b2s #:s2b #:make-reread-stream #:diff-diff-signs #:make-re/write-stream) (:nicknames :hop-util)) (in-package :binry-hop/util) (defun make-rectified-polynomial (n) " (make-rect-poly 3) -> lambda (x) rectified (expt x 3) " (lambda (x) (cond ((<= x 0) '0) ((< 0 x) (expt x n)) (t (error "unknown condition"))))) (defun bit-to-sign (bit) " (bit-to-sign 0) -> -1, 1 otherwise. " (cond ((zerop bit) (values '-1)) ((not (zerop bit)) (values '1) ) (t (error "unknown condition")))) (defun b2s (b) "bit-to-sign" (bit-to-sign b)) (defun sign-to-bit (sign) " (sign-to-bit -1) -> 0, 1 otherwise. " (cond ((minusp sign) (values '0)) ((not (minusp sign)) (values '1)) (t (error "unknown condition")))) (defun s2b (s) "sign-to-bit" (sign-to-bit s)) (defun make-reread-stream (file-stream &optional (restart-from :start)) " A utility lambda for READing until EOF (= nil) repeatedly open and close the stream yourself. (values (read enclosed-stream nil nil) loopedp) loopedp is T iff returned to restart-from" (lambda () (let ((memory (read file-stream nil nil))) (cond (memory (values (list memory nil))) ((not (equal (file-position file-stream) (file-length file-stream))) (values '(nil nil))) ((equal (file-position file-stream) (file-length file-stream)) (values (list nil (file-position file-stream restart-from)))) (t (error "unknown condition")))))) (defun diff-diff-signs (idx bit-array-1 bit-array-2 polynomial) " matching bit-array-1's bit at idx for bit-array-2" (loop for a across bit-array-1 for b across bit-array-2 for count from 0 for signed-ab = (* (b2s a) (b2s b)) summing (cond ((= count idx) (* +1 (b2s b))) ((not (= count idx)) signed-ab)) into plusp-idx-sum summing (cond ((= count idx) (* -1 (b2s b))) ((not (= count idx)) signed-ab)) into minusp-idx-sum finally (return (mapcar polynomial (list plusp-idx-sum minusp-idx-sum))))))) (defun make-re/write-stream (stream max-len) " of (stream array-eg) closure util for re/writing memory arrays " (lambda (&key seek peek memory length write) (typecase seek ((integer 0 *) (file-position stream (* (1+ max-len) seek))) (array (file-position stream 0) (loop for memory = (read stream) while (not (= (file-position stream) (file-length stream))) when (equalp seek memory) return (let ((pos (truncate (file-position stream) (1+ max-len)))) (file-position stream (* pos (1+ max-len))))))) (cond (length (values (truncate (file-length stream) max-len))) (peek (values (read-line stream nil nil) (file-position stream))) (write (let ((string (format nil "~s~{~a~}" memory (loop repeat (- max-len (+ (length memory) 2 (if memory 0 1))) collect #\space)))) (format write "~a" string) (terpri write))) (seek (file-position stream)) (t '(&key seek length peek write)))))