# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1598581028 14400
# Node ID acf092c22cdb925d850ff974d5d04785bf505d12
# Parent  55748ed99ff679be432584e1110fe9ccaf8a42b4
Work around a CCL bug

diff -r 55748ed99ff6 -r acf092c22cdb chancery.asd
--- a/chancery.asd	Tue Jan 14 19:51:58 2020 -0500
+++ b/chancery.asd	Thu Aug 27 22:17:08 2020 -0400
@@ -4,7 +4,7 @@
   :homepage "https://docs.stevelosh.com/chancery/"
 
   :license "MIT/X11"
-  :version "1.0.0"
+  :version "1.0.1"
 
   :depends-on (:named-readtables)
 
diff -r 55748ed99ff6 -r acf092c22cdb chancery.test.asd
--- a/chancery.test.asd	Tue Jan 14 19:51:58 2020 -0500
+++ b/chancery.test.asd	Thu Aug 27 22:17:08 2020 -0400
@@ -13,6 +13,5 @@
                 :serial t
                 :components ((:file "tests"))))
 
-  :perform (asdf:test-op
-             (op system)
-             (uiop:symbol-call :chancery.test :run-tests)))
+  :perform (asdf:test-op (op system)
+             (funcall (read-from-string "chancery.test:run-tests"))))
diff -r 55748ed99ff6 -r acf092c22cdb docs/03-changelog.markdown
--- a/docs/03-changelog.markdown	Tue Jan 14 19:51:58 2020 -0500
+++ b/docs/03-changelog.markdown	Thu Aug 27 22:17:08 2020 -0400
@@ -5,6 +5,11 @@
 
 [TOC]
 
+v1.0.1
+------
+
+Work around [a CCL bug](https://github.com/Clozure/ccl/issues/342).
+
 v1.0.0
 ------
 
diff -r 55748ed99ff6 -r acf092c22cdb src/chancery.lisp
--- a/src/chancery.lisp	Tue Jan 14 19:51:58 2020 -0500
+++ b/src/chancery.lisp	Thu Aug 27 22:17:08 2020 -0400
@@ -50,8 +50,8 @@
                                       #\A #\E #\I #\O #\U))))
 
 
-(defun prefix-sums (sequence &aux (sum 0))
-  (map 'list (lambda (n) (incf sum n)) sequence))
+(defun prefix-sums (sequence &aux (sum 0.0f0))
+  (map 'list (lambda (n) (incf sum (float n sum))) sequence))
 
 (defun separate-with-spaces (list)
   (-<> list
@@ -73,7 +73,9 @@
 
 ;;;; Weightlists --------------------------------------------------------------
 (defstruct (weightlist (:constructor %make-weightlist))
-  weights sums items total)
+  ;; items and weights are the original things passed in.
+  ;; sums and total are coerced to single floats for easier comparison.
+  items weights sums total)
 
 (defun make-weightlist (items weights)
   "Make a weightlist of the given items and weights.
@@ -86,7 +88,7 @@
     :items items
     :weights weights
     :sums (prefix-sums weights)
-    :total (apply #'+ 0.0 weights)))
+    :total (coerce (apply #'+ weights) 'single-float)))
 
 
 (defmethod print-object ((object weightlist) stream)
@@ -107,7 +109,8 @@
   (loop :with n = (chancery-random (weightlist-total weightlist))
         :for item :in (weightlist-items weightlist)
         :for weight :in (weightlist-sums weightlist)
-        :when (< n weight) :do (return item)))
+        ;; Use <= instead of < here to work around https://github.com/Clozure/ccl/issues/342
+        :when (<= n weight) :do (return item)))
 
 
 ;;;; Core ---------------------------------------------------------------------
diff -r 55748ed99ff6 -r acf092c22cdb test/tests.lisp
--- a/test/tests.lisp	Tue Jan 14 19:51:58 2020 -0500
+++ b/test/tests.lisp	Thu Aug 27 22:17:08 2020 -0400
@@ -71,5 +71,3 @@
 (define-test definition-macros
   (is (eql (sample-rule) :foo))
   (is (string= (sample-string) "Hello FOO")))
-
-(run-tests)