(no subject)
My deal-card function is basically a Knuth shuffle spread out over multiple calls to the deal-card routine. E.G. (shuffle-deck deck) just resets the card count, the actual "shuffling" is done by deal-card.
I originally implemented this by making my deck type a vector with a fill pointer - the fill pointer being the means to hide the already dealt cards in the deck. In other words, I'd grab a random number from 0 to the fill pointer (which is (random 53) for a newly allocated deck, making the range 0-52 inclusive, exactly what we want for a proper Knuth shuffle), get the new fill pointer value (one less than whatever it was before), and do the card swap, returning whatever card was at the random offset we picked.
This worked great - but when I told the compiler to be fast, it started complaining about not being able to optimize away a call to one of SBCL's internal access functions.
; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a (VECTOR FIXNUM 52), not a SIMPLE-ARRAY.
The problem is that (make-array 52 :element-type 'card) returns an array of type (simple-array FIXNUM (52)), while (make-array 52 :element-type 'card :fill-pointer 52) returns an array of type (vector fixnum 52). The fill pointer makes the array not simple (in accordance with the language spec).
So with the fill pointer, the function disassembly contains calls to SB-KERNEL:%DATA-VECTOR-AND-INDEX all over the place - basically, anywhere I called aref. I initially thought I just wasn't being smart enough to declare the types right (and this might be true), but I found old mailing list stuff saying you can't get rid of that note, or the calls.
Yet an aref on a (simple-array FIXNUM (52)) compiles down with no function calls at.
This is what I get for trying to be tricky. So i got trickier. If I allocate a 53 card array without a fill pointer, and treat offset zero as space to hold my "fill pointer", I get back a simple array - which SBCL will optimize nicely.
So I end up with something like this:
(defun deal-card (deck)
"Return a random card from the deck."
;; This is effectively a Fisher-Yates/Knuth shuffle spread out over
;; multiple calls, using a psuedo "fill-pointer" to maintain state
;; Originally this actually used the fill pointer, but non-simple arrays
;; mean function calls to SB-KERNEL:%DATA-VECTOR-AND-INDEX under SBCL :/
(declare (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0))
(type deck deck))
(macrolet ((fpointer (deck) `(aref ,deck 0)) ;; 'fill-pointer' like syntax
(prandom (count) `(1+ (random ,count)))) ;; Handle the random right
(let* ((fpointer (fpointer deck))
(newpointer (1- fpointer)))
(declare (type (integer 0 53) newpointer fpointer))
(if (zerop newpointer) (error "No cards left in the deck!")
(let ((index (prandom newpointer)))
(declare (type (integer 0 53) index))
(let ((card (aref deck index))
(newcard (aref deck newpointer)))
(setf (fpointer deck) newpointer
(aref deck index) newcard
(aref deck newpointer) card)))))))
That compiles down to code where the only function calls are to update the random state (because the range is so small on the random call, the actual function call to the mersenne twister gets optimized away) and to error if the user ever calls it when the deck is dead.
Sixty-one assembly instructions. This makes me happy.
Although it might be interesting to figure out what I'd need to change to get SBCL to be able optimize the calls away with the fill-pointer version ..
I originally implemented this by making my deck type a vector with a fill pointer - the fill pointer being the means to hide the already dealt cards in the deck. In other words, I'd grab a random number from 0 to the fill pointer (which is (random 53) for a newly allocated deck, making the range 0-52 inclusive, exactly what we want for a proper Knuth shuffle), get the new fill pointer value (one less than whatever it was before), and do the card swap, returning whatever card was at the random offset we picked.
This worked great - but when I told the compiler to be fast, it started complaining about not being able to optimize away a call to one of SBCL's internal access functions.
; note: unable to
; optimize
; due to type uncertainty:
; The first argument is a (VECTOR FIXNUM 52), not a SIMPLE-ARRAY.
The problem is that (make-array 52 :element-type 'card) returns an array of type (simple-array FIXNUM (52)), while (make-array 52 :element-type 'card :fill-pointer 52) returns an array of type (vector fixnum 52). The fill pointer makes the array not simple (in accordance with the language spec).
So with the fill pointer, the function disassembly contains calls to SB-KERNEL:%DATA-VECTOR-AND-INDEX all over the place - basically, anywhere I called aref. I initially thought I just wasn't being smart enough to declare the types right (and this might be true), but I found old mailing list stuff saying you can't get rid of that note, or the calls.
Yet an aref on a (simple-array FIXNUM (52)) compiles down with no function calls at.
This is what I get for trying to be tricky. So i got trickier. If I allocate a 53 card array without a fill pointer, and treat offset zero as space to hold my "fill pointer", I get back a simple array - which SBCL will optimize nicely.
So I end up with something like this:
(defun deal-card (deck)
"Return a random card from the deck."
;; This is effectively a Fisher-Yates/Knuth shuffle spread out over
;; multiple calls, using a psuedo "fill-pointer" to maintain state
;; Originally this actually used the fill pointer, but non-simple arrays
;; mean function calls to SB-KERNEL:%DATA-VECTOR-AND-INDEX under SBCL :/
(declare (optimize (speed 3) (safety 0) (debug 0) (compilation-speed 0))
(type deck deck))
(macrolet ((fpointer (deck) `(aref ,deck 0)) ;; 'fill-pointer' like syntax
(prandom (count) `(1+ (random ,count)))) ;; Handle the random right
(let* ((fpointer (fpointer deck))
(newpointer (1- fpointer)))
(declare (type (integer 0 53) newpointer fpointer))
(if (zerop newpointer) (error "No cards left in the deck!")
(let ((index (prandom newpointer)))
(declare (type (integer 0 53) index))
(let ((card (aref deck index))
(newcard (aref deck newpointer)))
(setf (fpointer deck) newpointer
(aref deck index) newcard
(aref deck newpointer) card)))))))
That compiles down to code where the only function calls are to update the random state (because the range is so small on the random call, the actual function call to the mersenne twister gets optimized away) and to error if the user ever calls it when the deck is dead.
Sixty-one assembly instructions. This makes me happy.
Although it might be interesting to figure out what I'd need to change to get SBCL to be able optimize the calls away with the fill-pointer version ..