seconds  |     consed     |    calls    |  sec/call  |  name  
------------------------------------------------------------------
    78.912 |  4,483,798,064 |  21,024,359 |   0.000004 | PARSE-FLOAT
    23.241 |  1,355,687,576 |  21,024,359 |   0.000001 | RADIX-VALUES
    13.190 |  1,161,869,384 |  21,024,359 |   0.000001 | TRIM-STRING
     0.315 |     15,258,864 |           3 |   0.105128 | GETBINS
     0.244 |              0 |  21,024,359 |  0.0000000 | ENSURE-LIST
     0.088 |     15,807,040 |       1,396 |   0.000063 | GETNBAYESSCORE
     0.010 |         49,152 |       4,188 |   0.000002 | CLEARMARKS
     0.000 |         90,112 |       1,396 |   0.000000 | GATHERDATA
     0.000 |              0 |           1 |   0.000000 | LEVELPRINT
     0.000 |  1,328,662,104 |       2,792 |   0.000000 | SETBINS
     0.000 |              0 |           1 |   0.000000 | TRACK-START
     0.000 |          8,104 |           1 |   0.000000 | SHOWRULESET
     0.000 |         32,768 |           3 |   0.000000 | HT2LIST
     0.000 |      8,306,384 |           1 |   0.000000 | RDR
     0.000 |          8,192 |           3 |   0.000000 | TRAIN
     0.000 |              0 |           1 |   0.000000 | TRACK-STOP
     0.000 |         28,568 |           3 |   0.000000 | DISTRIBUTION
     0.000 |              0 |       1,396 |   0.000000 | GETDATA
     0.000 |          4,024 |           1 |   0.000000 | WRITETOFILE
     0.000 |        102,504 |           2 |   0.000000 | CLEANDATA
     0.000 |    529,353,304 |       1,396 |   0.000000 | NBAYES
     0.000 |      1,377,120 |           1 |   0.000000 | GETMINMAX
     0.000 |  1,746,128,792 |  20,934,138 |   0.000000 | GETBIN
------------------------------------------------------------------
   116.001 | 10,646,572,056 | 105,044,159 |            | Total

(defun ensure-list (thing)
  "Returns THING as a list.

If THING is already a list (as per listp) it is returned,
otherwise a one element list containing THING is returned."
  (if (listp thing)
      thing
      (list thing)))

(defun trim-string (string &optional (char '(#\Space #\Tab #\Newline
                                             #\Return #\Linefeed)))
  (let ((chars (ensure-list char)))
    (subseq string 
	    (loop for index upfrom 0 below (length string)
		  when (not (member (aref string index) chars)) 
		    do (return index)
		  ;; if we get here we're trimming the entire string
                  finally (return-from trim-string ""))
	    (loop for index downfrom (length string)
		  when (not (member (aref string (1- index)) chars))
		    do (return index)))))

(defun radix-values (radix)
  (assert (<= 2 radix 35)
          (radix)
          "RADIX must be between 2 and 35 (inclusive), not ~D." radix)
  (make-array radix
              :displaced-to "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
              :displaced-index-offset 0
              :element-type 'character))

(defun parse-float (float-string
                    &key (start 0) (end nil) (radix 10)
                         (junk-allowed t)
                         (type 'single-float)
                         (decimal-character #\.))
  (let ((radix-array (radix-values radix))
        (integer-part 0)
        (mantissa 0)
        (mantissa-size 1)
        (sign 1))
    (with-input-from-string (float-stream (string-upcase (trim-string float-string)) :start start :end end)
      (labels ((peek () (peek-char nil float-stream nil nil nil))
               (next () (read-char float-stream nil nil nil))
               (sign () ;; reads the (optional) sign of the number
                 (cond
                   ((char= (peek) #\+) (next) (setf sign 1))
                   ((char= (peek) #\-) (next) (setf sign -1)))
                 (integer-part))
               (integer-part ()
                 (cond
                   ((position (peek) radix-array)
                    ;; the next char is a valid char
                    (setf integer-part (+ (* integer-part radix)
                                          (position (next) radix-array)))
                    ;; again
                    (return-from integer-part (integer-part)))
                   ((null (peek))
                    ;; end of string
                    (done))
                   ((char= decimal-character (peek))
                    ;; the decimal seperator
                    (next)
                    (return-from integer-part (mantissa)))                   
                   ;; junk
                   (junk-allowed (done))
                   (t (bad-string))))
               (mantissa ()                 
                 (cond
                   ((position (peek) radix-array)
                    (setf mantissa (+ (* mantissa radix)
                                      (position (next) radix-array))
                          mantissa-size (* mantissa-size radix))
                    (return-from mantissa
                      (mantissa)))
                   ((or (null (peek)) junk-allowed)
                    ;; end of string
                    (done))
                   (t (bad-string))))
               (bad-string ()
                 (error "Unable to parse ~S." float-string))
               (done ()
                 (return-from parse-float
                   (coerce (* sign (+ integer-part (/ mantissa mantissa-size))) type))))
        (sign)))))