Christian suggested I might have found a real bug, and that I should try stripping off as much fat as possible from my program. So I got it down to 157 lines. Here's the output:
% gsi trymutate.scm % gsc trymutate.scm; gcc -O2 -L. -I. trymutate.c trymutate_.c -lgambc; ./a.out *** ERROR IN intersect -- (Argument 2) LIST expected (member '(9 5 7) '(514 . 1))
Now if I uncomment the declarations (fixnum) & (not safe), I get: *** ERROR IN print-Sudoku -- (Argument 1) LIST expected (length '(514 . 6))
And if I comment out all the declarations, I get another different error: *** ERROR IN intersect -- (Argument 2) LIST expected (member '(9 5 7) '(() . 514))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; trymutate.scm
(declare (standard-bindings) ; (fixnum) ; (not safe) (run-time-bindings) (inline) (inlining-limit 1000) (block))
(define U7 '#(0 #(0 8 0 0 0 0 1 0 4 0) #(0 2 0 6 0 9 0 0 1 0) #(0 0 0 9 0 0 6 0 8 0) #(0 1 2 4 0 0 0 0 0 9) #(0 0 0 0 0 0 0 0 0 0) #(0 9 0 0 0 0 0 8 2 4) #(0 0 5 0 4 0 0 1 0 0) #(0 0 8 0 0 7 0 2 0 5) #(0 0 9 0 5 0 0 0 0 7)))
(define empty '()) (define empty? null?) (define first car) (define rest cdr) (define second cadr) (define (add1 x) (+ x 1)) (define (sub1 x) (- x 1))
;;nlist : N -> (listof N) ;; to construct list (0 1 2 .... n-1) (define (nlist n) (let loop ([n (sub1 n)] [accum empty]) (if (< n 0) accum (loop (sub1 n) (cons n accum)))))
;; build-list : N (N -> X) -> (listof X) ;; to construct (list (f 0) ... (f (- n 1))) (define (build-list n f) (map f (nlist n)))
(define (build-list9 f) (list (f 0) (f 1) (f 2) (f 3) (f 4) (f 5) (f 6) (f 7) (f 8)))
(define (build-list3 f) (list (f 0) (f 1) (f 2)))
; ;; filter : (X -> boolean) (listof X) -> (listof X) ; ;; to construct a list from all those items on aloX for which p holds (define (filter p aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (p x) (cons x (filter p (rest aloX))) (filter p (rest aloX))))))
;; remove* : (listof X) (listof X) -> (listof X) ;; to construct a list by removing from `aloX' all instances of the ;; list `items', where an instance is found by comparing `item' to the ;; elements of the list `aloX' items using `equal?'. (define (remove* items aloX) (if (empty? aloX) empty (let ([x (first aloX)]) (if (member x items) (remove* items (rest aloX)) (cons x (remove* items (rest aloX)))))))
;; intersect : (listof X)^2 -> (listof X) ;; to intersect 2 lists A and B. If A is sorted, then (intersect A B) ;; will be sorted too, given transitivity of the less-than? function. (define (intersect A B) (if (empty? A) empty (let ([a (first A)]) (if (member a B) (cons a (intersect (rest A) B)) (intersect (rest A) B)))))
(define (Val Sudoku Point) (vector-ref (vector-ref Sudoku (first Point)) (second Point)))
(define (Val-set! Sudoku Point new-value) (vector-set! (vector-ref Sudoku (first Point)) (second Point) new-value))
(define Grid (apply append (build-list9 (lambda (i) (build-list9 (lambda (j) (list (add1 i) (add1 j))))))))
(define (Rowlist Sudoku i) (filter number? (build-list9 (lambda (j) (Val Sudoku (list i (add1 j)))))))
(define (Columnlist Sudoku j) (filter number? (build-list9 (lambda (i) (Val Sudoku (list (add1 i) j))))))
(define (Boxlist Sudoku i j) (filter number? (let ([qi (* 3 (quotient (sub1 i) 3))] [qj (* 3 (quotient (sub1 j) 3))]) (apply append (build-list 3 (lambda (i) (build-list 3 (lambda (j) (Val Sudoku (list (+ qi i 1) (+ qj j 1)))))))))))
(define (list/num-size entry) (if (number? entry) 1 (length entry)))
(define (print-Sudoku Sudoku) (let* ([print-entry (lambda (i j) (list/num-size (Val Sudoku (list i j))))] [print-ith-row (lambda (i) (print-entry i 1) (print-entry i 2) (print-entry i 3) (print-entry i 4) (print-entry i 5) (print-entry i 6) (print-entry i 7) (print-entry i 8) (print-entry i 9))]) (map print-ith-row (list 1 2 3 4 5 6 7 8 9))))
(define (UnSpace Sudoku) (map (lambda (P) (if (zero? (Val Sudoku P)) (Val-set! Sudoku P (list 1 2 3 4 5 6 7 8 9)))) Grid))
(define (ShowPossibles Sudoku) ;; recalculate candidate lists, to take new numbers into account. (map (lambda (P) (let ([i (first P)] [j (second P)] [our-list (Val Sudoku P)]) (if (list? our-list) (let* ([incoming (append (list (Rowlist Sudoku i) (Columnlist Sudoku j) (Boxlist Sudoku i j)))] [rule-these-out (intersect incoming our-list)]) (if (not (empty? rule-these-out)) (Val-set! Sudoku P (remove* rule-these-out our-list))))))) Grid))
(UnSpace U7) (ShowPossibles U7) (ShowPossibles U7) (print-Sudoku U7)