(load "macros.scm")

;; backtracking closure
(define fail)


;; evaluate thunk nondeterministically.

;; this returns first possible solution. running (fail)
;; returns the next possible solution, until #f is returned
;; when all solutions are exhausted.

(define (with-choose thunk)
  (call/cc
   (lambda (done)
     (set! fail
	   (lambda ()
	     (done #f)))
     (thunk))))

;; macro to make chooser: nonderministic choice point
(define-macro (define-chooser name xcar xcdr)
  `(define (,name choices)
     (let ((backtrack fail))		; save current tracking point
       (call/cc 
	(lambda (return)		; bind return point for this choose
	  (let next 
	      ((lst choices))
	    (if (null? lst)
		(backtrack)		; we're done, call previous fail closure
		(begin
		  (set! fail		; install new fail closure...
			(lambda ()
			  (next 
			   (,xcdr lst))))	
		  (return 		; ...and return next value to continuation
		   (,xcar lst))))))))))

;; list and lazy list choosers
(define-chooser choose      car cdr)
(define-chooser lazy-choose lazy-car lazy-cdr)


(define (lazy-car lazy-list) (car lazy-list))
(define (lazy-cdr lazy-list) ((cdr lazy-list)))

;; create a lazy list from fixed list
;; cdr = lazy list generator thunk
(define (make-lazy-list lst)
  (if (null? lst) 
      lst
      (cons (car lst)
	    (lambda ()
	      (make-lazy-list (cdr lst))))))

;; create lazy list from generator
;; has to be finite for choose to work (depth first!)
(define (lazy-list-from-generator generator)
  (let ((first generator))
    (if first
	(cons first
	      (lambda ()
		lazy-list-from-generator generator))
	'())))

  
;; create lazy list from range
(define (make-lazy-range start endx)
  (if (= start endx)
      '()
      (cons start
	    (lambda ()
	      (make-lazy-range
	       (+ 1 start) endx)))))


;; declare a restriction (fail -> try next)
(define (require predicate)
  (if (not predicate) (fail)))


;; TEST
;; run a nondeterministic program

(define (args1) 
  (list 
   (choose '(1 2 3)) 
   (choose '(4 5 6))))

(define (args2) 
  (list 
   (lazy-choose (make-lazy-range 1 10))
   (lazy-choose (make-lazy-range 1 10))))


(define (choose-test)
  (let ((solution 
	 (with-choose
	  (lambda ()
	    (let ((args (args2)))
	      (require (= 7 (apply + args)))
	      args)))))

    ;; print solution if not false, then fail
    ;; this will print all solutions
    (if solution 
	(begin
	  (display solution)
	  (newline)
	  (fail)))))