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

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

@ -168,29 +168,27 @@
(define solutions null) (define solutions null)
(define (solve-cell! cell board) (define (solve-cell! cell board)
(cond (when (and (positive? to-go)
[(to-go . <= . 0) (not (negative? cell)))
;; Got enough solutions ;; Need solutions and not off board
(void)] (cond
[(= 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) [else
;; Out of board ;; Recur
(void)] (for ([color (in-range 10)])
[else (when (zero? (vector-ref masks color))
(for ([color (in-range 10)]) (for ([mask (in-list (vector-ref
(when (zero? (vector-ref masks color)) (vector-ref masks-at-cell cell)
(for ([mask (in-list (vector-ref color))])
(vector-ref masks-at-cell cell) (when (zero? (bitwise-and mask board))
color))]) (vector-set! masks color mask)
(when (zero? (bitwise-and mask board)) (solve-cell! (sub1 cell) (bitwise-ior board mask))
(vector-set! masks color mask) (vector-set! masks color 0)))))])))
(solve-cell! (sub1 cell) (bitwise-ior board mask))
(vector-set! masks color 0)))))]))
(define (add-solutions!) (define (add-solutions!)
(let ([digits (let ([digits