[gambit-list] strange mutation problem (bug?)

Bill Richter richter at math.northwestern.edu
Wed Sep 27 16:05:16 EDT 2006


I have a Scheme program (about 1500 lines long) I've run under gsi
over & over again with great results.  But I get segfaults if I use
gsc/gcc instead, even with drastically simpler version of the program.

My guess is that it's a mutation problem, involving my function
Val-set!  So first the bad gsc/gcc output, the good gsi output, and
then the program, which is unfortunately about 500 lines long.  At
least there are very few Val-set! occurences.

 % ll gambit.h libgambc.so 
lrwxrwxrwx  1 richter users 46 Sep 25 20:45 gambit.h -> /rhome/richter/Gambit/current/include/gambit.h
lrwxrwxrwx  1 richter users 45 Sep 25 20:46 libgambc.so -> /rhome/richter/Gambit/current/lib/libgambc.so
 % echo $LD_LIBRARY_PATH
/rhome/richter/Gambit/current/lib

My beta 19 installation look OK?  Now let's run the offending program:

% gsc trymutate.scm; gcc -O2 -L. -I.  trymutate.c trymutate_.c -lgambc; ./a.out 

Show Possibles
Check for Solved Cells
cell B9 set to 3
A | 8       37      357     | 237     235     1       | 35679   4       236     
B | 2       347     6       | 378     9       34578   | 357     1       3       
C | 3457    1347    9       | 237     2345    6       | 357     8       23      
  +-------------------------+-------------------------+-------------------------
D | 1       2       4       | 3678    3568    3578    | 3567    3567    9       
E | 3567    367     3578    | 1236789 1234568 2345789 | 3567    3567    136     
F | 9       367     357     | 1367    1356    357     | 8       2       4       
  +-------------------------+-------------------------+-------------------------
G | 367     5       237     | 4       2368    2389    | 1       369     368     
H | 346     8       13      | 1369    7       39      | 2       369     5       
J | 346     9       123     | 5       12368   238     | 346     36      7       

Show Possibles
#t8
#f00
#t5678
#t12
#t96
#t1
#t5679
#t4
#t26
#t2
#t47
#t6
#t78
#t9
#t4578
#t57
#t1
#t3
#t24514514951415142514751451451455149
#f5514
#t9
#f514514251492568536870909238514
#f8514
#t6
#t57
#t8
#t2
#t1
#t2
#t4
#f514
#f51495141514
#f2514
#f7514
#f5145145514
#t9
#f5148
#f5149
#f5141
#f514
#f514
#f514
#f5146
#f5146
#t16
#t9
#f5140
#f5145
#f5148
#t514514806Segmentation fault





*******************************************************
Every #f should've been #t.  
Here's the nice output from gsi:
%  gsi trymutate.scm 
*******************************************************

Show Possibles
Check for Solved Cells
cell B9 set to 3
A | 8       37      357     | 237     235     1       | 35679   4       236     
B | 2       347     6       | 378     9       34578   | 357     1       3       
C | 3457    1347    9       | 237     2345    6       | 357     8       23      
  +-------------------------+-------------------------+-------------------------
D | 1       2       4       | 3678    3568    3578    | 3567    3567    9       
E | 3567    367     3578    | 1236789 1234568 2345789 | 3567    3567    136     
F | 9       367     357     | 1367    1356    357     | 8       2       4       
  +-------------------------+-------------------------+-------------------------
G | 367     5       237     | 4       2368    2389    | 1       369     368     
H | 346     8       13      | 1369    7       39      | 2       369     5       
J | 346     9       123     | 5       12368   238     | 346     36      7       

Show Possibles
Check for Solved Cells
cell C9 set to 2
A | 8       37      357     | 237     235     1       | 5679    4       26      
B | 2       47      6       | 78      9       4578    | 57      1       3       
C | 3457    1347    9       | 237     2345    6       | 57      8       2       
  +-------------------------+-------------------------+-------------------------
D | 1       2       4       | 3678    3568    3578    | 3567    3567    9       
E | 3567    367     3578    | 1236789 1234568 2345789 | 3567    3567    16      
F | 9       367     357     | 1367    1356    357     | 8       2       4       
  +-------------------------+-------------------------+-------------------------
G | 367     5       237     | 4       2368    2389    | 1       369     68      
H | 346     8       13      | 1369    7       39      | 2       369     5       
J | 346     9       123     | 5       12368   238     | 346     36      7       

Show Possibles
A | 8       37      357     | 237     235     1       | 5679    4       6       
B | 2       47      6       | 78      9       4578    | 57      1       3       
C | 3457    1347    9       | 37      345     6       | 57      8       2       
  +-------------------------+-------------------------+-------------------------
D | 1       2       4       | 3678    3568    3578    | 3567    3567    9       
E | 3567    367     3578    | 1236789 1234568 2345789 | 3567    3567    16      
F | 9       367     357     | 1367    1356    357     | 8       2       4       
  +-------------------------+-------------------------+-------------------------
G | 367     5       237     | 4       2368    2389    | 1       369     68      
H | 346     8       13      | 1369    7       39      | 2       369     5       
J | 346     9       123     | 5       12368   238     | 346     36      7       

#t8
#t37
#t357
#t237
#t235
#t1
#t5679
#t4
#t6
#t2
#t47
#t6
#t78
#t9
#t4578
#t57
#t1
#t3
#t3457
#t1347
#t9
#t37
#t345
#t6
#t57
#t8
#t2
#t1
#t2
#t4
#t3678
#t3568
#t3578
#t3567
#t3567
#t9
#t3567
#t367
#t3578
#t1236789
#t1234568
#t2345789
#t3567
#t3567
#t16
#t9
#t367
#t357
#t1367
#t1356
#t357
#t8
#t2
#t4
#t367
#t5
#t237
#t4
#t2368
#t2389
#t1
#t369
#t68
#t346
#t8
#t13
#t1369
#t7
#t39
#t2
#t369
#t5
#t346
#t9
#t123
#t5
#t12368
#t238
#t346
#t36
#t7
A | 8       37      357     | 237     235     1       | 5679    4       6       
B | 2       47      6       | 78      9       4578    | 57      1       3       
C | 3457    1347    9       | 37      345     6       | 57      8       2       
  +-------------------------+-------------------------+-------------------------
D | 1       2       4       | 3678    3568    3578    | 3567    3567    9       
E | 3567    367     3578    | 1236789 1234568 2345789 | 3567    3567    16      
F | 9       367     357     | 1367    1356    357     | 8       2       4       
  +-------------------------+-------------------------+-------------------------
G | 367     5       237     | 4       2368    2389    | 1       369     68      
H | 346     8       13      | 1369    7       39      | 2       369     5       
J | 346     9       123     | 5       12368   238     | 346     36      7       



*******************************************************
*******trymutate.scm 
*******************************************************

(declare
 (standard-bindings)
 (fixnum)
 (not safe)
 (run-time-bindings)
 (inline)
 (inlining-limit 1000)
 (block))


;Import  U#7: 800001040206090010009006080124000009000000000900000824050400100080070205090500007
;http://www.scanraid.com/sudoku.htm?bd=800001040206090010009006080124000009000000000900000824050400100080070205090500007

(define U#7 '#(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 true #t)
(define false #f)
(define first car)
(define rest cdr)
(define second cadr)
(define third caddr)
(define fourth cadddr)
(define (fifth alist)
  (first (cddddr alist)))
(define (add1 x)
  (+ x 1))
(define (sub1 x)
  (- x 1))

(define (symbol=? x y)
  (and (symbol? x)
       (symbol? y)
       (equal? x y)))

;;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)))

; ;; 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))))))

; (define (build-vector n f)
;   (do ((vec (make-vector n))
;        (i 0 (+ i 1)))
;       ((= i n) vec)
;     (vector-set! vec i (f i))))

; ;; remove : X (listof X) -> (listof X)
; ;; to construct a list by removing from `aloX' the first instance of
; ;; `item', where an instance is found by comparing `item' to the
; ;; elements of the list `aloX' items using `equal?'.
(define (remove item aloX)     
  (if (empty? aloX)
      empty
      (let ([x (first aloX)])
        (if (equal? item x)
            (rest aloX)
            (cons x (remove item (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)))))))



; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; ;;; General purpose HtDP-type functions

; ;; union : (listof (listof X)) -> (listof X)
; ;; to take the union of a B1 union ... Bn of a collection of lists B =
; ;; (B1 ... Bn), with no repetitions.
(define (union B)
  (if (empty? B)
      empty
      (let ([b (first B)])
        (append b (remove* b (union (rest B)))))))

; ;; 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)))))

; ;; forall : (X -> boolean) (listof X) -> boolean
; ;; to test if (F x) is true for all elements x in X.
; ;; So if X is empty, return true.
(define (forall F X)
  (or (empty? X)
      (and (F (first X))
           (forall F (rest X)))))

; ;; forallv : (X -> void) (listof X) -> void
; ;; like forall or map, but don't test, and don't return a value.
(define (forallv F X)
  (if (not (empty? X))
      (begin
        (F (first X))
        (forallv F (rest X)))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Basic Sudoku functions involving points & grids etc.
;;; Points are lists (1--9 1--9), Sudokus are vector^2s of either numbers or lists of numbers

(define (digit? x)
  (member x '(1 2 3 4 5 6 7 8 9)))

(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 (make-Point i j)
  (list i j))

(define (Point-first Point)
  (first Point))

(define (Point-second Point)
  (second Point))

(define Grid
  (apply append (build-list 9 
                            (lambda (i) (build-list 9 
						    (lambda (j) (make-Point (add1 i) (add1 j))))))))

(define (cell? P)
  (member P Grid))

(define  (Rowlist Sudoku i)
  (filter number? 
          (build-list 9 (lambda (j) (Val Sudoku (make-Point i (add1 j)))))))

(define  (Columnlist Sudoku j)
  (filter number?
          (build-list 9 (lambda (i) (Val Sudoku (make-Point (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 (make-Point (+ qi i 1) (+ qj j 1)))))))))))

(define Rows 
  (build-list 9 
              (lambda (i) (build-list 9 
                                      (lambda (j) (make-Point (add1 i) (add1 j)))))))

(define Cols
  (build-list 9 
              (lambda (j) (build-list 9 
                                      (lambda (i) (make-Point (add1 i) (add1 j)))))))

(define Boxes
  (apply append
         (build-list 3 
                     (lambda (qi) 
                       (build-list 3
                                   (lambda (qj) 
                                     (apply append 
                                            (build-list 3  
                                                        (lambda (i) 
                                                          (build-list 3 (lambda (j) 
                                                                          (make-Point (+ (* 3 qi) i 1)
                                                                                      (+ (* 3 qj) j 1)))))))))))))

(define Units
  (append Rows Cols Boxes))

(define (EmptyCells Sudoku)
  (filter (lambda (P) 
            (list? (Val Sudoku P))) 
          Grid))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Printing & other basic setup chores.

(define (print-Sudoku Sudoku)
  (define (list->number alon)
    (let loop ([ralon (reverse alon)] [index 0] [accum 0])
      (if (empty? ralon)
          accum
          (loop (rest ralon) (add1 index) (+ accum (* (expt 10 index) (first ralon)))))))
  
  (define (list/num-size entry)
    (if (number? entry)
        1
        (if (string? entry)
            (string-length entry)
            (if (not (list? entry))
                (display entry)
                (length entry)))))
  
  (define (biggest Sudoku)
    (define (PointSize P)
      (list/num-size (Val Sudoku P)))
    (apply max 
           (append (map PointSize Grid))))
  
  (define (print-char char n)
    ;; print n spaces
    (do 
        ([i 0 (add1 i)])
      ([= i n])
      (display char)))
  
  (let* ([entry-width (biggest Sudoku)]
         [print-entry 
          (lambda (i j)
            (let ([entry (Val Sudoku (make-Point i j))])
              (if (list? entry)
                  (display (list->number entry))
                  (display entry))
              ;; print a number of spaces: biggest - list/num-size
              (print-char " " (- entry-width (list/num-size entry)))          
              (display " ")))]
         [print-ith-row 
          (lambda (i)
            (newline) (displayASbeg i)
            (print-entry i 1) (print-entry i 2) (print-entry i 3) (display "| ")
            (print-entry i 4) (print-entry i 5) (print-entry i 6) (display "| ")
            (print-entry i 7) (print-entry i 8) (print-entry i 9))]
         [print-block-divider
          (lambda ()
            (newline) (display "  +-")
            (print-char "-" (+ 3 (* entry-width 3))) (display "+-")
            (print-char "-" (+ 3 (* entry-width 3))) (display "+-")
            (print-char "-" (+ 3 (* entry-width 3))))])
    
        (print-ith-row 1) (print-ith-row 2) (print-ith-row 3) (print-block-divider)
    (print-ith-row 4) (print-ith-row 5) (print-ith-row 6) (print-block-divider)
    (print-ith-row 7) (print-ith-row 8) (print-ith-row 9) (newline)))

(define (displayASbeg x)
    (cond 
      [(= x 1) (display 'A)]
      [(= x 2) (display 'B)]
      [(= x 3) (display 'C)]
      [(= x 4) (display 'D)]
      [(= x 5) (display 'E)]
      [(= x 6) (display 'F)]
      [(= x 7) (display 'G)]
      [(= x 8) (display 'H)]
      [(= x 9) (display 'J)])
  (display " | "))

(define (displayAS-cell cell)
  ;; to turn a list (x y) to Andrew's Solver Notation. 
  ;; so (5 8) turns to E8
  (let ([x (first cell)] [y (second cell)])
    (cond 
      [(= x 1) (display 'A)]
      [(= x 2) (display 'B)]
      [(= x 3) (display 'C)]
      [(= x 4) (display 'D)]
      [(= x 5) (display 'E)]
      [(= x 6) (display 'F)]
      [(= x 7) (display 'G)]
      [(= x 8) (display 'H)]
      [(= x 9) (display 'J)])
    (display y)))
     

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Stepper Technique Scheduler, and initial moves


(define status 'new)


                   
 ;; first we print the puzzle, and it looks nice to not show the 0s. 
(define (Zero->Space Sudoku)
  (forallv (lambda (P)
             (let ([entry (Val Sudoku P)])
             (if (zero? entry)
                 (Val-set! Sudoku P " "))))
           Grid)
  (print-Sudoku Sudoku))


(define (UnSpace Sudoku) 
  (forallv (lambda (P) 
             (if (zero? (Val Sudoku P))
                 (Val-set! Sudoku P '(1 2 3 4 5 6 7 8 9))))
           Grid))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Actual Techniques!

(define (CheckSolvedCell Sudoku)
  ;; upgrades every singleton candidate list to a big number
  (newline)
  (display "Check for Solved Cells")
        (forallv (lambda (P) 
                 (let ([val (Val Sudoku P)])
                   (if (list? val)
                       (let ([x (first val)])
                         (if (equal? val (list x))
                             (begin 
                               (set! status 'solved-cell)
                               (Val-set! Sudoku P x)
                               (newline) 
                               (display "cell ") (displayAS-cell P) (display " set to ") (display x)))))))
               Grid)
  (if (forall (lambda (P) 
                (number? (Val Sudoku P)))
              Grid)
      (set! status 'finished)))
      


(define (ShowPossibles Sudoku)
  ;; recalculate candidate lists, to take new numbers into account.
  (newline);(newline)
  (display "Show Possibles")
  (forallv (lambda (P)
             (let ([i (Point-first P)] 
                   [j (Point-second P)] 
                   [our-list (Val Sudoku P)]) 
               (if (list? our-list)
                   (let* ([incoming (union (list (Rowlist Sudoku i) 
                                                 (Columnlist Sudoku j) 
                                                 (Boxlist Sudoku i j)))]
                          [rule-these-out (intersect incoming our-list)])
                     (if (not (empty? rule-these-out))
                         (begin
                           (set! status 'need-check)
                           (Val-set! Sudoku P (remove* rule-these-out our-list))))))))
           Grid))

;(Zero->Space U#7)
(UnSpace U#7)
(ShowPossibles U#7)
(CheckSolvedCell U#7)
(print-Sudoku U#7)
(ShowPossibles U#7)
(CheckSolvedCell U#7)
(print-Sudoku U#7)
(ShowPossibles U#7)
(print-Sudoku U#7)

;(display U#7)

(forallv (lambda (P)
           (newline)
           (let ([Plist (Val U#7 P)])
           (display (or (number? Plist) (string? Plist) (list? Plist)))
           (display Plist)))
         Grid)

(print-Sudoku U#7)
; (CheckSolvedCell U#7)
; (print-Sudoku U#7)

; gcc -O2 -L. -I.  MC.c MC_.c -lgambc
; gcc -O2 -L. -I.  trygamb.c trygamb_.c -lgambc



More information about the Gambit-list mailing list