gistfile1.sls

(define panel #(5 3 0  0 7 0  0 0 0
        6 0 0  1 9 5  0 0 0
        0 9 8  0 0 0  0 6 0
         
        8 0 0  0 6 0  0 0 3
        4 0 0  8 0 3  0 0 1
        7 0 0  0 2 0  0 0 6

        0 6 0  0 0 0  2 8 0
        0 0 0  4 1 9  0 0 5
        0 0 0  0 8 0  0 7 9))

(define make-init-list (lambda (panel)
             (define l '())
             (let loop ((i (- (vector-length panel) 1)))
              (if (> i -1)
               (begin
                (set! l (cons 
                     (if (zero? (vector-ref panel i))
                      (list (remainder i 9) (quotient i 9) '(1 2 3 4 5 6 7 8 9))
                      (vector-ref panel i))
                     l))
                (loop (- i 1)))))
             l))

(define show-panel (lambda (panel)
           (let loop ((y 0))
            (if (< y 9)
             (begin
              (if (zero? (remainder y 3)) (newline))
              (let inner-loop ((x 0))
               (if (< x 9)
                (begin 
                 (if (zero? (remainder x 3)) (display " "))
                 (display (number-with-xy panel x y))
                 (display " ")
                 (inner-loop (+ x 1)))))
              (newline)
              (loop (+ y 1)))))))

(define xy-to-index (lambda (x y)
           (+ (* y 9) x)))

(define number-with-xy 
 (lambda (vec x y) (vector-ref vec (xy-to-index x y))))

(define in-box-number-list (lambda (vec x y)
             (let ((offset-x (* (quotient x 3) 3))
                (offset-y (* (quotient y 3) 3))
                (number-list '()))
              (let loop ((i 0))
               (if (< i 3)
                (begin 
                 (let inner-loop ((j 0))
                  (if (< j 3) 
                   (begin 
                    (if (not (zero? (number-with-xy vec (+ offset-x j) (+ offset-x i))))
                     (set! number-list (cons (number-with-xy vec (+ offset-x j) (+ offset-y i)) number-list)))
                    (inner-loop (+ j 1)))))
                 (loop (+ i 1)))))
              number-list)))

(define vline-number-list (lambda (vec x)
              (define number-list '())
              (let loop ((i 0))
               (if (< i 9)
                (begin
                 (if (not (zero? (number-with-xy vec x i)))
                  (set! number-list (cons (number-with-xy vec x i) number-list)))
                 (loop (+ i 1)))))
              number-list))

(define hline-number-list (lambda (vec y)
              (define number-list '())
              (let loop ((i 0))
               (if (< i 9)
                (begin
                 (if (not (zero? (number-with-xy vec i y)))
                  (set! number-list (cons (number-with-xy vec i y) number-list)))
                 (loop (+ i 1)))))
              number-list))

(define contains? (lambda (l v)
          (let loop ((l l))
           (if (null? l) 
            #f
            (if (= v (car l))
             #t
             (loop (cdr l)))))))


(define check-number? (lambda (vec x y v)
          (not (or 
             (contains? (in-box-number-list vec x y) v)
             (contains? (vline-number-list vec x) v)
             (contains? (hline-number-list vec y) v)))))

(define vector-set (lambda (vec k v)
           (set! vec (vector-copy vec))
           (vector-set! vec k v)
           vec))


(define suudok-slove (lambda (panel)
  (let/cc esc-cont 
      (define continuation-slove (lambda (cont panel l)
                 (cond
                  ((null? l) (esc-cont panel))
                  ((number? (car l)) (continuation-slove cont panel (cdr l)))
                  (else 
                   (let ((x (car (car l)))
                      (y (car (cdr (car l)))))
                    (let loop ((candidate (car (cdr (cdr (car l))))))
                     (cond
                      ((null? candidate) (cont '()))
                      ((check-number? panel x y (car candidate))
                      (call/cc (lambda (c)
                            (continuation-slove c (vector-set panel (xy-to-index x y) (car candidate)) (cdr l))))))
                     (loop (cdr candidate))))))))
      (call/cc (lambda (c) (continuation-slove c panel (make-init-list panel)))))))

(show-panel (suudok-slove panel))