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