-
+ DD4119C228C1EEBA80482F41CB8677CB56F9B282C0AAEE6C92FCAC43610C6CA0E27FF7DBABC2919E738CEE32C94508260D6B73E1D76657E76912893A457667A7
esthlos-v/src/keccak/src/bits.lisp
(0 . 0)(1 . 65)
63 (in-package "CL-KECCAK")
64
65 (defun bit-chunk (bit-vector chunk-size)
66 (assert (= 0 (mod (length bit-vector) chunk-size)))
67 (let ((chunks '()))
68 (dotimes (c (/ (length bit-vector) chunk-size))
69 (push (subseq bit-vector
70 (* c chunk-size)
71 (* (1+ c) chunk-size))
72 chunks))
73 (nreverse chunks)))
74
75 (defun bit-pad-right (bv n)
76 (do ((x (coerce bv 'list) (append x '(0))))
77 ((>= (length x) n)
78 (coerce x 'simple-bit-vector))))
79
80 (defun bit-vector-concatenate (bit-vector-sequence)
81 (apply #'concatenate 'simple-bit-vector bit-vector-sequence))
82
83 (defun bit-vector-concatenate-uniform-vector (bit-vector-vector member-size)
84 (let ((rtn (make-sequence 'simple-bit-vector
85 (* member-size (length bit-vector-vector)))))
86 (dotimes (i (length bit-vector-vector))
87 (replace rtn
88 (aref bit-vector-vector i)
89 :start1 (* i member-size)
90 :end1 (* (1+ i) member-size)))
91 rtn))
92
93 (defun bit-vector-to-integer (bv)
94 (reduce #'(lambda (a b) (+ a (* 2 b)))
95 bv
96 :from-end t))
97
98 (defun bit-vector-to-hex (bv)
99 (apply #'concatenate
100 'string
101 (mapcar (lambda (n)
102 (let ((s (write-to-string n :base 16)))
103 (if (= (length s) 2)
104 s
105 (concatenate 'string "0" s))))
106 (mapcar #'bit-vector-to-integer
107 (bit-chunk bv 8)))))
108
109 (defun integer-to-bit-vector (n)
110 (labels ((bit-array-iter (n array)
111 (if (zerop n)
112 array
113 (multiple-value-bind (q r)
114 (floor n 2)
115 (bit-array-iter q
116 (append array (list r)))))))
117 (bit-pad-right (bit-array-iter n '()) 8)))
118
119 (defun file-to-bit-vector (filepath)
120 (with-open-file (f filepath :direction :input :element-type 'bit)
121 (bit-vector-concatenate-uniform-vector
122 (map 'vector
123 #'integer-to-bit-vector
124 (let ((s (make-sequence 'list (file-length f))))
125 (read-sequence s f)
126 s))
127 +bits-in-byte+)))