[gambit-list] "Number of arguments exceeds implementation
Bill Richter
richter at math.northwestern.edu
Fri Sep 29 02:17:27 EDT 2006
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)
More information about the Gambit-list
mailing list