[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