Key

Fully covered - every single instruction executed

Partly covered - entered but some subforms not executed

Never entered - not a single instruction executed

Uninstrumented - a form whose coverage was not measured

1 (in-package :alu.utils)
2 
3 (defconstant +byte-size+ 8)
4 
5 (-> string-to-number (string) integer)
6 (defun string-to-number (string)
7   "converts a string to a numerical encoding"
8   ;; if we had map-accum-r, we could do this with an accumulator
9   (assure integer
10     (let ((cont 0))
11       (sum (map 'list
12                 (lambda (c)
13                   (prog1
14                       (ash (char-code c) (* cont +byte-size+))
15                     (incf cont (char-byte-size c))))
16                 ;; we should probably remove this and encode it with the
17                 ;; first element in the last position of the bitstring.
18                 (reverse string))))))

 (lambda (string)
   (ccl::typed-form 'integer
    (let* ((#:datum50400
            (let* ((cont 0))
              (funcall 'sum
                       (funcall 'map
                                'list
                                (function (lambda (c)
                                            (prog1 (ash (char-code c) (ccl::mul2 8 cont))
                                                   (let* ((#:g50402
                                                           (funcall 'char-byte-size (ccl::typed-form 'character c)))
                                                          (#:g50401 (ccl::add2 cont #:g50402)))
                                                     (setq cont #:g50401)))))
                                (funcall 'reverse string))))))
      (if (let* ((#:g50404 (ccl::typecode #:datum50400)))
            (if (ccl::%i<> ':eq #:g50404 0) t (ccl::%i<> ':eq #:g50404 25)))
          #:datum50400
          (ccl::typed-form 'integer (funcall 'serapeum::%require-type #:datum50400 'integer))))))

19 
20 (-> sequence-to-number (fixnum sequence) integer)
21 (defun sequence-to-number (size arr)
22   "converts a sequence literal to a numerical encoding"
23   (assure integer
24     (sum (map 'list
25               (lambda (ele count) (ash ele (* count size)))
26               arr
27               (alexandria:iota (length arr))))))

 (lambda (size arr)
   (ccl::typed-form 'integer
    (let* ((#:datum50417
            (funcall 'sum
                     (funcall 'map
                              'list
                              (function (lambda (ele count) (ash ele (ccl::mul2 count size))))
                              arr
                              (funcall 'alexandria:iota (funcall 11 arr))))))
      (if (let* ((#:g50419 (ccl::typecode #:datum50417)))
            (if (ccl::%i<> ':eq #:g50419 0) t (ccl::%i<> ':eq #:g50419 25)))
          #:datum50417
          (ccl::typed-form 'integer (funcall 'serapeum::%require-type #:datum50417 'integer))))))

28 
29 ;; I can speed this up by manually setfing the fill pointer instead,
30 ;; or tracking it, but makes the code less clear
31 (-> string-to-bit-array (string) bit-vector)
32 (defun string-to-bit-array (string)
33   "converts a string to a bit-vector encoding. Should agree with `string-to-number'"
34   (let* ((size      (string-bit-size string))
35          (bit-array (make-array size :element-type 'bit :fill-pointer 0)))
36     (map nil (lambda (c) (char-to-bit-array c bit-array)) string)
37     bit-array))

 (lambda (string)
   (let* ((size (funcall 'string-bit-size (ccl::typed-form 'base-string string)))
          (bit-array
           (ccl::typed-form '(array bit)
            (let* ((#:dims size)) (funcall 'ccl::make-uarray-1 247 #:dims nil 0 nil nil nil nil nil nil)))))
     (progn (funcall 'map
                     nil
                     (function (lambda (c)
                                 (funcall 'char-to-bit-array
                                          (ccl::typed-form 'character c)
                                          (ccl::typed-form 'bit-vector bit-array))))
                     string)
            bit-array)))

38 
39 (-> char-to-bit-array (character &optional bit-vector) bit-vector)
40 (defun char-to-bit-array (char &optional
41                                  (bit-array (make-array (char-code char)
42                                                         :element-type 'bit
43                                                         :fill-pointer 0)))
44   (let ((numb (char-code char))
45         (size (char-bit-size char)))
46     (dotimes (i (char-bit-size char) bit-array)
47       (vector-push (if (logbitp (- size i 1) numb) 1 0) bit-array))))

 (lambda (char &optional
          (bit-array
           (ccl::typed-form '(array bit)
            (let* ((#:dims (char-code char))) (funcall 'ccl::make-uarray-1 247 #:dims nil 0 nil nil nil nil nil nil)))
           #:compiler-var))
   (let ((numb (char-code char)) (size (funcall 'char-bit-size (ccl::typed-form 'character char))))
     (let* ((#:g50444 (funcall 'char-bit-size (ccl::typed-form 'character char))) (i 0))
       (progn (tagbody (go #:g50446)
                       (#:g50445 nil (0) #<var #:|tagbody-catch-tag| #x302003525E0D> t t)
                       (funcall 'vector-push
                                (if (logbitp (ccl::sub2 (ccl::fixnum-sub-overflow size i) 1) numb) 1 0)
                                bit-array)
                       (ccl::%decls-body (setq i (ccl::fixnum-add-no-overflow 1 i)))
                       (#:g50446 nil (0) #<var #:|tagbody-catch-tag| #x302003525E0D> t nil)
                       (if (ccl::%i<> ':lt i #:g50444) (go #:g50445) nil))
              bit-array))))

48 
49 (-> string-bit-size (string) fixnum)
50 (defun string-bit-size (string)
51   (* (string-byte-size string) +byte-size+))

 (lambda (string) (ash (funcall 'string-byte-size (ccl::typed-form 'base-string string)) 3))

52 
53 (-> char-bit-size (character) fixnum)
54 (defun char-bit-size (char)
55   (* (char-byte-size char) +byte-size+))

 (lambda (char) (ash (funcall 'char-byte-size (ccl::typed-form 'character char)) 3))

56 
57 (-> string-byte-size (string) fixnum)
58 (defun string-byte-size (string)
59   (values
60    (sum (map 'list #'char-byte-size string))))

 (lambda (string) (values (funcall 'sum (funcall 'map 'list (function char-byte-size) string))))

61 
62 (-> char-byte-size (character) fixnum)
63 (defun char-byte-size (char)
64   "Calculates how many bytes is needed to model the current char"
65   (ceiling (integer-length (char-code char))
66            +byte-size+))

 (lambda (char) (funcall 'ceiling (funcall 'integer-length (char-code char)) 8))

Coverage report: home:Documents;Work;Repo;alu;src;util;bit.lisp.newest