(define amb-fail '*)

(define initialize-amb-fail
  (lambda ()
    (set! amb-fail
      (lambda ()
        (error "amb tree exhausted")))))

(define-macro amb
  (lambda alts...
    `(let ((+prev-amb-fail amb-fail))
       (call/cc
        (lambda (+sk)

          ,@(map (lambda (alt)
                   `(call/cc
                     (lambda (+fk)
                       (set! amb-fail
                         (lambda ()
                           (set! amb-fail +prev-amb-fail)
                           (+fk 'fail)))
                       (+sk ,alt))))
                 alts...)

          (+prev-amb-fail))))))

(define number-between
  (lambda (lo hi)
    (let loop ((i lo))
      (if (> i hi) (amb)
          (amb i (loop (+ i 1)))))))

(define assert
  (lambda (pred)
    (if (not pred) (amb))))

(define-macro bag-of
  (lambda (e)
    `(let ((+prev-amb-fail amb-fail)
           (+results '()))
       (if (call/cc
            (lambda (+k)
              (set! amb-fail (lambda () (+k #f)))
              (let ((+v ,e))
                (set! +results (cons +v +results))
                (+k #t))))
           (amb-fail))
       (set! amb-fail +prev-amb-fail)
       (reverse! +results))))

(define move-ok?
  (lambda (moves cell mover) (if (null? moves) #t
                                 (if (= (car (car moves)) cell)
                                     #f
                                     (move-ok? (cdr moves) cell mover)))))

(define compile-moves
  (lambda (moves) (if (null? moves)
                      '(- - - - - - - - -)
                      (let ((move (car moves)) (part-board (compile-moves (cdr moves))))
                        (append (reverse (list-tail (reverse part-board) (- (length part-board) (car move))))
                                (list (cadr move))
                                (list-tail part-board (+ (car move) 1))
                                )))))

(define is-cells-win?
  (lambda (board cell1 cell2 cell3) (let ((c1 (list-ref board cell1)) (c2 (list-ref board cell2)) (c3 (list-ref board cell3)))
                                      (and (symbol=? c1 c2)
                                           (symbol=? c2 c3)
                                           (not (symbol=? c1 '-))
                                           c1
                                           ))))
; 0 1 2
; 3 4 5
; 6 7 8
(define WIN-CELLS
  '((0 1 2)
    (3 4 5)
    (6 7 8)
    (0 3 6)
    (1 4 7)
    (2 5 8)
    (0 4 8)
    (2 4 6)
    ))

(define is-win?
  (lambda (board) (apply ormap (lambda lst (apply is-cells-win? board lst)) (apply map list WIN-CELLS))))


(define make-move
  (lambda (moves cell mover) (begin
                               (assert (move-ok? moves cell mover))
                               (cons (list cell mover) moves)
                               )))

(define play-game
  (lambda (moves mover) (let ((next-mover (if (eq? mover 'x) 'o 'x)) (next-moves (make-move moves (number-between 0 8) mover)))
                          (if (is-win? (compile-moves next-moves))
                              next-moves
                              (play-game next-moves next-mover)))))
                          


(define count= (lambda (lst val) (apply + (map (lambda (x) (if (eq? x val) 1 0)) lst))))
(define board-ok?
  (lambda (board) (let ((cx (count= board 'x)) (co (count= board 'o)) (w? (is-win? board)))
                    (and (or
                          (= cx co)
                          (= cx (+ co 1)))
                         (if w?
                             (let ((winc (count= board w?)) (losec (count= board (if (eq? 'x w?) 'o 'x))))
                               (= winc (+ losec 1))
                               )
                             #t
                             )))))

(define find-boards
  (lambda (moves mover) (let* ((next-mover (if (eq? mover 'x) 'o 'x)) 
                              (next-moves (cons (list (number-between 0 8) mover) moves))
                              (board (compile-moves moves))
                              (ok? (board-ok? board))
                              )
                         (if ok?
                             (cons board (bag-of (find-boards next-moves next-mover)))
                             '()))))