SMOLNET PORTAL home about changes
(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)))))
Response: text/plain
Original URLgopher://tilde.institute/0/~screwtape/binry-hop/src/util.lisp
Content-Typetext/plain; charset=utf-8