k-nucleotide Lisp SBCL #6 program

;; The Computer Language Benchmarks Game
;;   https://salsa.debian.org/benchmarksgame-team/benchmarksgame/
;;
;;   contributed by Currell Berry
;;
;; Based on Java submission #1

(defpackage :knucleotide2
  (:use :cl))

(in-package :knucleotide2)

(declaim (optimize (speed 3) (safety 0) (space 0) (debug 0)))
(declaim (inline get-key))

;; simple thread runner implementation
;; we have a semaphore
(defparameter *my-tr-available-thread-semaphore* nil)
;; each time a thread finishes up, we increment this semaphore
;; the main thread waits on the semaphore, whenever it goes above 0 it finds another task if one is available and
;; starts it up


(defparameter *my-tr-task-remaining-count* 0)
(declaim (type fixnum *my-tr-task-remaining-count*))
(defparameter *my-tr-completed-task-mutex* nil)
(defparameter *my-tr-task-completed-cv* nil)

;;writing to status and result should only be done in my-tr-run
(defstruct my-task
  (mylambda) ; the thing to run
  (status nil) ; nil or t
  (result nil))

(defparameter *my-task-list* #())
(declaim (type vector *my-task-list*))

;; must have set up populated *my-task-list* first
;; each time a thread becomes available, then we run the next task
(defun my-tr-run (threadcount)
  (declare (type fixnum threadcount))
  (setf *my-tr-available-thread-semaphore* (sb-thread:make-semaphore :count threadcount))
  (setf *my-tr-completed-task-mutex* (sb-thread:make-mutex)) 
  (setf *my-tr-task-remaining-count* (length *my-task-list*)) 
  (setf *my-tr-task-completed-cv* (sb-thread:make-waitqueue)) 
  (loop for taskindex from 0 below (length *my-task-list*) do
       (sb-thread:wait-on-semaphore *my-tr-available-thread-semaphore*)
       (let ((thetask (elt *my-task-list* taskindex)))
         (sb-thread:make-thread (lambda () (let ((results
                                                  (funcall (my-task-mylambda thetask))))
                                             (setf (my-task-result thetask) results)
                                             (setf (my-task-status thetask) t)
                                             (sb-thread:signal-semaphore *my-tr-available-thread-semaphore*)
                                             (sb-thread:with-mutex (*my-tr-completed-task-mutex*)
                                               (decf *my-tr-task-remaining-count*)
                                               (sb-thread:condition-notify *my-tr-task-completed-cv*)
                                               )
                                             )))))
  (loop
     (sb-thread:with-mutex (*my-tr-completed-task-mutex*)
       (if (eql *my-tr-task-remaining-count* 0)
           (return)
           (sb-thread:condition-wait *my-tr-task-completed-cv* *my-tr-completed-task-mutex*)))))

(defconstant CODES  #(-1 0 -1 1 3 -1 -1 2)) 
(defconstant NUCLEOTIDES #(#\A #\C #\G #\T)) 

(defun hash-function (x)
  (declare (type (unsigned-byte 64) x))
  x)

(defstruct result
  (outmap (make-hash-table
           :test 'eql
           :hash-function #'hash-function
           :rehash-size 2.0
           :rehash-threshold 0.7))
  (keylength 0))

(defun create-fragment-tasks (sequence mfragment-lengths)
  (declare (type (simple-array (unsigned-byte 8) (*)) sequence))
  (let ((tasks (make-array 46 :fill-pointer 0)))
    (loop for fragmentLength across mfragment-lengths do
         (loop for i of-type (unsigned-byte 32) from 0 below fragmentLength do
              (let ((offset i)
                    (mfragmentlength fragmentLength))
                (vector-push-extend
                 (make-my-task :mylambda
                               (lambda ()
                                 (declare (type (unsigned-byte 32) mfragmentlength)
                                          (type (unsigned-byte 32) offset))
                                 (create-fragment-map sequence offset mfragmentlength)
                                 ))
                 tasks))))
    tasks))

(defun create-fragment-map (sequence offset fragmentLength)
  (declare (type (simple-array (unsigned-byte 8) (*)) sequence)
           (type (unsigned-byte 32) offset)
           (type (unsigned-byte 32) fragmentLength))
  (let* ((res (make-result :keylength fragmentLength))
         (mymap (result-outmap res))
         (lastIndex (+ (- (length sequence) fragmentLength) 1)))
    (declare (type (unsigned-byte 32) lastIndex))
    (loop
       for index of-type (unsigned-byte 32) from offset below lastIndex by fragmentLength
       do
         (let* ((key (get-key sequence index fragmentLength))
                (value (gethash key mymap 0)))
           (declare (type (unsigned-byte 64) key)
                    (type (unsigned-byte 32) value))
           (setf (gethash key mymap 0) (the (unsigned-byte 32) (+ value 1)))))
    res))

(defun sum-two-maps (result1 result2)
  (loop for key2 of-type (unsigned-byte 64) being the hash-keys  of (result-outmap result2)
     using (hash-value value2) do
       (setf (gethash key2 (result-outmap result1)) (+ (the (unsigned-byte 32) (gethash key2 (result-outmap result1) 0)) (the (unsigned-byte 32) value2))))
  result1
  )

(defun write-frequencies (totalCount frequencies)
  (let ((freq (make-array (hash-table-count (result-outmap frequencies)) :fill-pointer 0 :element-type 'cons)))
    (loop for key being the hash-keys of (result-outmap frequencies)
       using (hash-value cnt) do
         (let ((nentry (cons (key-to-string key (result-keylength frequencies)) cnt)))
           (vector-push-extend nentry freq)))
    (sort freq (lambda (x y) (> (cdr x) (cdr y))))
    (let ((outstr
           (apply #'concatenate 
                  (append (list 'string)
                          (loop for index from 0 below (length freq)
                                           for (key . value) = (elt freq index)
                                           collect 
                                             (format nil "~a ~,3f~%" key (/ (* value 100.0) totalCount)))))))
      outstr)))

(defun write-count (tasks nucleotideFragment)
  (let* ((key (to-codes-new (map '(vector (unsigned-byte 8)) #'char-code nucleotideFragment) (length nucleotideFragment)) )
         (k (get-key key 0 (length nucleotideFragment)))
         (count 0))
    (loop for task across tasks 
       for result = (my-task-result task) do
         (if (eql (result-keylength result) (length nucleotideFragment))
             (setf count (+ count (gethash k (result-outmap result) 0)))))
    (format nil "~a~c~a~%" count #\tab nucleotideFragment)))

(defun key-to-string (key length)
  (declare (type (unsigned-byte 64) key)
           (type (unsigned-byte 32) length))
  (let ((res (make-string length)))
    (loop for i from 0 below length do
         (setf (elt res (- length i 1)) (elt NUCLEOTIDES (logand key #x3)))
         (setf key (ash key -2)))
    res))

(defun get-key (arr offset length)
  (declare (type (simple-array (unsigned-byte 8)) arr)
           (type (unsigned-byte 32) offset)
           (type (unsigned-byte 32) length))
  (let ((key 0))
    (declare (type (unsigned-byte 64) key))
    (loop for i of-type (unsigned-byte 32) from offset below (+ offset length) do
         (setf key (the fixnum (+ (the fixnum (* key 4)) (the fixnum (elt arr i))))))
    key))

(defun to-codes-new (sequence length)
  (declare (type (simple-array (unsigned-byte 8) (*)) sequence)
           (type (unsigned-byte 32) length)
           )
  (let ((result (make-array length :element-type '(unsigned-byte 8))))
    (loop for i of-type (unsigned-byte 32) from 0 below length do
         (setf (elt result i) (elt CODES (logand (elt sequence i) #x7))))
    result))

(defconstant FRAGMENT-LENGTHS  #(1 2 3 4 6 12 18)) 
(defconstant NUCLEOTIDE-FRAGMENTS #("GGT" "GGTA" "GGTATT" "GGTATTTTAATT"
                                           "GGTATTTTAATTTATAGT" ))
(defconstant DNA_THREE_IN_BYTES (map '(simple-array (unsigned-byte 8) (*)) #'char-code ">THREE"))
(defconstant NEWLINE-CODE  (map '(simple-array (unsigned-byte 8) (*)) #'char-code "
")) 

(defun read-ascii-file-to-binary-array (filename)
  (with-open-stream (stream (open filename :element-type '(unsigned-byte 8)))
    (let* ((buffer
            (make-array (file-length stream)
                        :element-type
                        '(unsigned-byte 8))))
      (read-sequence buffer stream)
      buffer)))

(defun read-in-data-chunked (ifilename)
  (let ((bytes (read-ascii-file-to-binary-array ifilename)))
    (declare (type (simple-array (unsigned-byte 8) (*)) bytes))
    ;;we have read all the data!
    ;;we have to doctor the array so that it no longer has newlines and junk
    ;;  (print-range bytes 0 100)
    (let* ((threestart (search DNA_THREE_IN_BYTES bytes))
           (realstart (the (unsigned-byte 32) (search NEWLINE-CODE bytes :start2 threestart)))
           (writeposition 0))
      (declare (type (unsigned-byte 32) threestart)
               (type (unsigned-byte 32) realstart)
               (type (unsigned-byte 32) writeposition)) 
      (loop for pos from realstart below (length bytes) do
           (let ((nchar (aref bytes pos)))
             (if (not (eql nchar 10)) ; newline
                 (progn
                   (setf (aref bytes writeposition) (aref bytes pos))
                   (incf writeposition))
                 )))
      (let ((outarr (make-array writeposition :element-type '(unsigned-byte 8))))
        (declare (type (simple-array (unsigned-byte 8) (*)) outarr))
        (loop for i from 0 below writeposition do
             (setf (aref outarr i) (aref bytes i)))
        (return-from read-in-data-chunked outarr)))))

(defun main ()
  (let* ((pifile #p"/dev/stdin")
         (msequenceraw (read-in-data-chunked pifile))
         (msequence (to-codes-new msequenceraw (length msequenceraw))))
;    (setf *tbytes* msequenceraw)
    (setf *my-task-list* (create-fragment-tasks msequence FRAGMENT-LENGTHS))
    (my-tr-run 4)
    (format t "~a~%" (write-frequencies (length msequence) (my-task-result (elt *my-task-list* 0))))
    
    (format t "~a~%" (write-frequencies (- (length msequence) 1) (sum-two-maps
                                                       (my-task-result (elt *my-task-list* 1))
                                                       (my-task-result (elt *my-task-list* 2))
                                                                  )))
    (loop for nucleotide-fragment across NUCLEOTIDE-FRAGMENTS do
         (princ (write-count *my-task-list*  nucleotide-fragment)))
))

(in-package :cl-user)

(defun main ()
  (knucleotide2::main))
    

NOTES:
64-bit Ubuntu quad core
SBCL 2.0.4


Thu, 21 May 2020 23:58:04 GMT

MAKE:
cp: 'knucleotide.sbcl-6.sbcl' and './knucleotide.sbcl-6.sbcl' are the same file
SBCL built with: /usr/local/bin/sbcl --userinit /dev/null --batch --eval '(load "knucleotide.sbcl-6.sbcl_compile")'
### START knucleotide.sbcl-6.sbcl_compile
(handler-bind ((sb-ext:defconstant-uneql      (lambda (c) (abort c))))      (require :sb-concurrency)      (load (compile-file "knucleotide.sbcl-6.sbcl" ))) (save-lisp-and-die "sbcl.core" :purify t)
### END knucleotide.sbcl-6.sbcl_compile

; compiling file "/home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl" (written 26 APR 2018 12:48:18 PM):
; compiling (DEFPACKAGE :KNUCLEOTIDE2 ...)
; compiling (IN-PACKAGE :KNUCLEOTIDE2)
; compiling (DECLAIM (OPTIMIZE # ...))
; compiling (DECLAIM (INLINE GET-KEY))
; compiling (DEFPARAMETER *MY-TR-AVAILABLE-THREAD-SEMAPHORE* ...)
; compiling (DEFPARAMETER *MY-TR-TASK-REMAINING-COUNT* ...)
; compiling (DECLAIM (TYPE FIXNUM ...))
; compiling (DEFPARAMETER *MY-TR-COMPLETED-TASK-MUTEX* ...)
; compiling (DEFPARAMETER *MY-TR-TASK-COMPLETED-CV* ...)
; compiling (DEFSTRUCT MY-TASK ...)
; compiling (DEFPARAMETER *MY-TASK-LIST* ...)
; compiling (DECLAIM (TYPE VECTOR ...))
; compiling (DEFUN MY-TR-RUN ...)
; file: /home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl
; in: DEFUN MY-TR-RUN
;     (ELT KNUCLEOTIDE2::*MY-TASK-LIST* KNUCLEOTIDE2::TASKINDEX)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a VECTOR, not a (SIMPLE-ARRAY * (*)).

;     (FUNCALL (KNUCLEOTIDE2::MY-TASK-MYLAMBDA KNUCLEOTIDE2::THETASK))
; --> SB-C::%FUNCALL THE 
; ==>
;   (SB-KERNEL:%COERCE-CALLABLE-FOR-CALL
;    (KNUCLEOTIDE2::MY-TASK-MYLAMBDA KNUCLEOTIDE2::THETASK))
; 
; note: unable to
;   optimize away possible call to FDEFINITION at runtime
; because:
;   callable expression is not known to be a function

; compiling (DEFCONSTANT CODES ...)
; compiling (DEFCONSTANT NUCLEOTIDES ...)
; compiling (DEFUN HASH-FUNCTION ...)
; compiling (DEFSTRUCT RESULT ...)
; compiling (DEFUN CREATE-FRAGMENT-TASKS ...)
; file: /home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl
; in: DEFUN CREATE-FRAGMENT-TASKS
;     (LOOP KNUCLEOTIDE2::FOR KNUCLEOTIDE2::FRAGMENTLENGTH KNUCLEOTIDE2::ACROSS KNUCLEOTIDE2::MFRAGMENT-LENGTHS
;           DO (LOOP KNUCLEOTIDE2::FOR KNUCLEOTIDE2::I KNUCLEOTIDE2::OF-TYPE (UNSIGNED-BYTE
;                                                                             32) KNUCLEOTIDE2::FROM 0 KNUCLEOTIDE2::BELOW KNUCLEOTIDE2::FRAGMENTLENGTH
;                    DO (LET ((KNUCLEOTIDE2::OFFSET KNUCLEOTIDE2::I)
;                             (KNUCLEOTIDE2::MFRAGMENTLENGTH
;                              KNUCLEOTIDE2::FRAGMENTLENGTH))
;                         (VECTOR-PUSH-EXTEND
;                          (KNUCLEOTIDE2::MAKE-MY-TASK :MYLAMBDA #)
;                          KNUCLEOTIDE2::TASKS))))
; --> BLOCK LET LET TAGBODY SB-LOOP::LOOP-DESETQ SETQ THE AREF 
; ==>
;   (SB-KERNEL:HAIRY-DATA-VECTOR-REF ARRAY SB-INT:INDEX)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a VECTOR, not a SIMPLE-STRING.
; 
; note: unable to
;   avoid runtime dispatch on array element type
; due to type uncertainty:
;   The first argument is a VECTOR, not a SIMPLE-ARRAY.

; compiling (DEFUN CREATE-FRAGMENT-MAP ...)
; file: /home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl
; in: DEFUN CREATE-FRAGMENT-MAP
;     (DEFUN KNUCLEOTIDE2::CREATE-FRAGMENT-MAP
;            (SEQUENCE KNUCLEOTIDE2::OFFSET KNUCLEOTIDE2::FRAGMENTLENGTH)
;       (DECLARE (TYPE (SIMPLE-ARRAY (UNSIGNED-BYTE 8) (*)) SEQUENCE)
;                (TYPE (UNSIGNED-BYTE 32) KNUCLEOTIDE2::OFFSET)
;                (TYPE (UNSIGNED-BYTE 32) KNUCLEOTIDE2::FRAGMENTLENGTH))
;       (LET* ((KNUCLEOTIDE2::RES
;               (KNUCLEOTIDE2::MAKE-RESULT :KEYLENGTH
;                KNUCLEOTIDE2::FRAGMENTLENGTH))
;              (KNUCLEOTIDE2::MYMAP
;               (KNUCLEOTIDE2::RESULT-OUTMAP KNUCLEOTIDE2::RES))
;              (KNUCLEOTIDE2::LASTINDEX (+ # 1)))
;         (DECLARE (TYPE (UNSIGNED-BYTE 32) KNUCLEOTIDE2::LASTINDEX))
;         (LOOP KNUCLEOTIDE2::FOR KNUCLEOTIDE2::INDEX KNUCLEOTIDE2::OF-TYPE (UNSIGNED-BYTE
;                                                                            32) KNUCLEOTIDE2::FROM KNUCLEOTIDE2::OFFSET KNUCLEOTIDE2::BELOW KNUCLEOTIDE2::LASTINDEX KNUCLEOTIDE2::BY KNUCLEOTIDE2::FRAGMENTLENGTH
;               DO ...)
;         KNUCLEOTIDE2::RES))
; --> PROGN 
; ==>
;   (SB-IMPL::%DEFUN 'KNUCLEOTIDE2::CREATE-FRAGMENT-MAP
;                    (SB-INT:NAMED-LAMBDA KNUCLEOTIDE2::CREATE-FRAGMENT-MAP
;                        (SEQUENCE KNUCLEOTIDE2::OFFSET
;                         KNUCLEOTIDE2::FRAGMENTLENGTH)
;                      (DECLARE (SB-C::TOP-LEVEL-FORM))
;                      (DECLARE (TYPE (SIMPLE-ARRAY # #) SEQUENCE)
;                               (TYPE (UNSIGNED-BYTE 32) KNUCLEOTIDE2::OFFSET)
;                               (TYPE (UNSIGNED-BYTE 32)
;                                KNUCLEOTIDE2::FRAGMENTLENGTH))
;                      (BLOCK KNUCLEOTIDE2::CREATE-FRAGMENT-MAP
;                        (LET* (# # #)
;                          (DECLARE #)
;                          (LOOP KNUCLEOTIDE2::FOR KNUCLEOTIDE2::INDEX KNUCLEOTIDE2::OF-TYPE # KNUCLEOTIDE2::FROM KNUCLEOTIDE2::OFFSET KNUCLEOTIDE2::BELOW KNUCLEOTIDE2::LASTINDEX KNUCLEOTIDE2::BY KNUCLEOTIDE2::FRAGMENTLENGTH
;                                DO ...)
;                          KNUCLEOTIDE2::RES))))
; 
; caught STYLE-WARNING:
;   Call to KNUCLEOTIDE2::GET-KEY could not be inlined because no definition for it
;   was seen prior to its first use.

; compiling (DEFUN SUM-TWO-MAPS ...)
; compiling (DEFUN WRITE-FREQUENCIES ...)
; file: /home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl
; in: DEFUN WRITE-FREQUENCIES
;     (SORT KNUCLEOTIDE2::FREQ
;           (LAMBDA (KNUCLEOTIDE2::X KNUCLEOTIDE2::Y)
;             (> (CDR KNUCLEOTIDE2::X) (CDR KNUCLEOTIDE2::Y))))
; --> BLOCK LET SB-IMPL::SEQ-DISPATCH IF LET SB-IMPL::STABLE-SORT-LIST BLOCK 
; --> LABELS SB-IMPL::MERGE* BLOCK VALUES SB-IMPL::MERGE-LISTS* 
; ==>
;   SB-IMPL::TEST
; 
; note: could not stack allocate SB-IMPL::TEST in:
;        (SORT FREQ (LAMBDA (X Y) (> (CDR X) (CDR Y))))

; ==>
;   SB-IMPL::KEY
; 
; note: could not stack allocate SB-IMPL::KEY in:
;        (SORT FREQ (LAMBDA (X Y) (> (CDR X) (CDR Y))))

; --> BLOCK LET SB-IMPL::SEQ-DISPATCH IF LET SB-IMPL::STABLE-SORT-LIST 
; ==>
;   SB-IMPL::PREDICATE-FUN
; 
; note: could not stack allocate SB-IMPL::PREDICATE-FUN in:
;        (SORT FREQ (LAMBDA (X Y) (> (CDR X) (CDR Y))))

;     (MAKE-ARRAY
;      (HASH-TABLE-COUNT (KNUCLEOTIDE2::RESULT-OUTMAP KNUCLEOTIDE2::FREQUENCIES))
;      :FILL-POINTER 0 :ELEMENT-TYPE 'CONS)
; 
; caught STYLE-WARNING:
;   The default initial element 0 is not a CONS.

;     (SORT KNUCLEOTIDE2::FREQ
;           (LAMBDA (KNUCLEOTIDE2::X KNUCLEOTIDE2::Y)
;             (> (CDR KNUCLEOTIDE2::X) (CDR KNUCLEOTIDE2::Y))))
; --> LOCALLY SB-C::%FUNCALL 
; ==>
;   SB-IMPL::PREDICATE
; 
; note: could not stack allocate: (SORT FREQ (LAMBDA (X Y) (> (CDR X) (CDR Y))))

;     (> (CDR KNUCLEOTIDE2::X) (CDR KNUCLEOTIDE2::Y))
; 
; note: unable to
;   open-code FLOAT to RATIONAL comparison
; due to type uncertainty:
;   The first argument is a REAL, not a FLOAT.
;   The second argument is a REAL, not a RATIONAL.

;     (/ (* KNUCLEOTIDE2::VALUE 100.0) KNUCLEOTIDE2::TOTALCOUNT)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
;   The second argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a NUMBER, not a SINGLE-FLOAT.
;   The second argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
;   The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a NUMBER, not a DOUBLE-FLOAT.
;   The second argument is a NUMBER, not a (COMPLEX DOUBLE-FLOAT).
; 
; note: unable to
;   convert x/2^k to shift
; due to type uncertainty:
;   The first argument is a NUMBER, not a INTEGER.
;   The second argument is a NUMBER, not a INTEGER.

;     (* KNUCLEOTIDE2::VALUE 100.0)
; 
; note: forced to do GENERIC-* (cost 30)
;       unable to do inline float arithmetic (cost 4) because:
;       The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES
;                                                         (COMPLEX SINGLE-FLOAT)
;                                                         &REST T).
;       unable to do inline float arithmetic (cost 4) because:
;       The first argument is a NUMBER, not a SINGLE-FLOAT.
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES SINGLE-FLOAT
;                                                                &REST T).

;     (/ (* KNUCLEOTIDE2::VALUE 100.0) KNUCLEOTIDE2::TOTALCOUNT)
; 
; note: forced to do full call
;       unable to do inline float arithmetic (cost 12) because:
;       The first argument is a NUMBER, not a SINGLE-FLOAT.
;       The second argument is a NUMBER, not a SINGLE-FLOAT.
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES SINGLE-FLOAT
;                                                                &REST T).
;       unable to do inline float arithmetic (cost 12) because:
;       The first argument is a NUMBER, not a (COMPLEX SINGLE-FLOAT).
;       The second argument is a NUMBER, not a SINGLE-FLOAT.
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES
;                                                         (COMPLEX SINGLE-FLOAT)
;                                                         &REST T).
;       etc.

;     (> (CDR KNUCLEOTIDE2::X) (CDR KNUCLEOTIDE2::Y))
; 
; note: forced to do GENERIC-> (cost 10)
;       unable to do inline float comparison (cost 3) because:
;       The first argument is a REAL, not a SINGLE-FLOAT.
;       The second argument is a REAL, not a SINGLE-FLOAT.
;       unable to do inline float comparison (cost 3) because:
;       The first argument is a REAL, not a DOUBLE-FLOAT.
;       The second argument is a REAL, not a DOUBLE-FLOAT.
;       etc.

; compiling (DEFUN WRITE-COUNT ...)
; file: /home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl
; in: DEFUN WRITE-COUNT
;     (MAP '(VECTOR (UNSIGNED-BYTE 8)) #'CHAR-CODE KNUCLEOTIDE2::NUCLEOTIDEFRAGMENT)
; --> TRULY-THE SB-KERNEL:%MAP MAP-INTO MAKE-SEQUENCE MIN LET 
; ==>
;   (LENGTH #:G7)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a SEQUENCE, not a VECTOR.

;     (LENGTH KNUCLEOTIDE2::NUCLEOTIDEFRAGMENT)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a SEQUENCE, not a VECTOR.
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a SEQUENCE, not a VECTOR.

;     (LOOP KNUCLEOTIDE2::FOR KNUCLEOTIDE2::TASK KNUCLEOTIDE2::ACROSS KNUCLEOTIDE2::TASKS
;           KNUCLEOTIDE2::FOR KNUCLEOTIDE2::RESULT = (KNUCLEOTIDE2::MY-TASK-RESULT
;                                                     KNUCLEOTIDE2::TASK)
;           DO (IF (EQL (KNUCLEOTIDE2::RESULT-KEYLENGTH KNUCLEOTIDE2::RESULT)
;                       (LENGTH KNUCLEOTIDE2::NUCLEOTIDEFRAGMENT))
;                  (SETF COUNT (+ COUNT #))))
; --> BLOCK LET LET LET TAGBODY SB-LOOP::LOOP-DESETQ SETQ THE AREF 
; ==>
;   (SB-KERNEL:HAIRY-DATA-VECTOR-REF ARRAY SB-INT:INDEX)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a VECTOR, not a SIMPLE-STRING.
; 
; note: unable to
;   avoid runtime dispatch on array element type
; due to type uncertainty:
;   The first argument is a VECTOR, not a SIMPLE-ARRAY.

;     (LENGTH KNUCLEOTIDE2::NUCLEOTIDEFRAGMENT)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a SEQUENCE, not a VECTOR.

;     (+ COUNT
;        (GETHASH KNUCLEOTIDE2::K
;                 (KNUCLEOTIDE2::RESULT-OUTMAP KNUCLEOTIDE2::RESULT) 0))
; 
; note: forced to do GENERIC-+ (cost 10)
;       unable to do inline float arithmetic (cost 2) because:
;       The first argument is a NUMBER, not a DOUBLE-FLOAT.
;       The second argument is a NUMBER, not a DOUBLE-FLOAT.
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES DOUBLE-FLOAT
;                                                                &REST T).
;       unable to do inline float arithmetic (cost 2) because:
;       The first argument is a NUMBER, not a SINGLE-FLOAT.
;       The second argument is a NUMBER, not a SINGLE-FLOAT.
;       The result is a (VALUES NUMBER &OPTIONAL), not a (VALUES SINGLE-FLOAT
;                                                                &REST T).
;       etc.

; compiling (DEFUN KEY-TO-STRING ...)
; compiling (DEFUN GET-KEY ...)
; compiling (DEFUN TO-CODES-NEW ...)
; compiling (DEFCONSTANT FRAGMENT-LENGTHS ...)
; compiling (DEFCONSTANT NUCLEOTIDE-FRAGMENTS ...)
; compiling (DEFCONSTANT DNA_THREE_IN_BYTES ...)
; compiling (DEFCONSTANT NEWLINE-CODE ...)
; compiling (DEFUN READ-ASCII-FILE-TO-BINARY-ARRAY ...)
; compiling (DEFUN READ-IN-DATA-CHUNKED ...)
; compiling (DEFUN MAIN ...)
; file: /home/dunham/8000-benchmarksgame/bench/knucleotide/knucleotide.sbcl-6.sbcl
; in: DEFUN MAIN
;     (ELT KNUCLEOTIDE2::*MY-TASK-LIST* 0)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a VECTOR, not a (SIMPLE-ARRAY * (*)).

;     (ELT KNUCLEOTIDE2::*MY-TASK-LIST* 1)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a VECTOR, not a (SIMPLE-ARRAY * (*)).

;     (ELT KNUCLEOTIDE2::*MY-TASK-LIST* 2)
; 
; note: unable to
;   optimize
; due to type uncertainty:
;   The first argument is a VECTOR, not a (SIMPLE-ARRAY * (*)).

; compiling (IN-PACKAGE :CL-USER)
; compiling (DEFUN MAIN ...); 
; compilation unit finished
;   caught 2 STYLE-WARNING conditions
;   printed 27 notes


; wrote /home/dunham/benchmarksgame_quadcore/knucleotide/tmp/knucleotide.sbcl-6.fasl
; compilation finished in 0:00:00.451
### START knucleotide.sbcl-6.sbcl_run
(main) (quit)
### END knucleotide.sbcl-6.sbcl_run


5.03s to complete and log all make actions

COMMAND LINE:
/usr/local/bin/sbcl  --noinform --core sbcl.core --userinit /dev/null --load knucleotide.sbcl-6.sbcl_run 0 < knucleotide-input25000000.txt

PROGRAM OUTPUT:
A 30.295
T 30.151
C 19.800
G 19.754

AA 9.177
TA 9.132
AT 9.131
TT 9.091
CA 6.002
AC 6.001
AG 5.987
GA 5.984
CT 5.971
TC 5.971
GT 5.957
TG 5.956
CC 3.917
GC 3.911
CG 3.909
GG 3.902

1471758	GGT
446535	GGTA
47336	GGTATT
893	GGTATTTTAATT
893	GGTATTTTAATTTATAGT