[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