suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more shootout clean-up

Browse Source 
svn: r10841
This commit is contained in:
Matthew Flatt 2008-07-19 14:47:13 +00:00
parent 55a44ae5bc
commit 1091050692
1 changed files with 21 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/tests/mzscheme/benchmarks/shootout/meteor.ss
View File

@ -168,20 +168,18 @@
(define solutions null) (define solutions null)
(define (solve-cell! cell board) (define (solve-cell! cell board)
(when (and (positive? to-go)
(not (negative? cell)))
;; Need solutions and not off board
(cond (cond
[(to-go . <= . 0)
;; Got enough solutions
(void)]
[(= board #x3FFFFFFFFFFFF) [(= board #x3FFFFFFFFFFFF)
;; Solved ;; Solved
(add-solutions!)] (add-solutions!)]
[(not (clear? board cell)) [(not (clear? board cell))
;; Cell full ;; Cell full, so try next
(solve-cell! (sub1 cell) board)] (solve-cell! (sub1 cell) board)]
[(cell . < . 0)
;; Out of board
(void)]
[else [else
;; Recur
(for ([color (in-range 10)]) (for ([color (in-range 10)])
(when (zero? (vector-ref masks color)) (when (zero? (vector-ref masks color))
(for ([mask (in-list (vector-ref (for ([mask (in-list (vector-ref
@ -190,7 +188,7 @@
(when (zero? (bitwise-and mask board)) (when (zero? (bitwise-and mask board))
(vector-set! masks color mask) (vector-set! masks color mask)
(solve-cell! (sub1 cell) (bitwise-ior board mask)) (solve-cell! (sub1 cell) (bitwise-ior board mask))
(vector-set! masks color 0)))))])) (vector-set! masks color 0)))))])))
(define (add-solutions!) (define (add-solutions!)
(let ([digits (let ([digits