codepad

Language:

(define (fail)
  (error 'amb "tree exhausted"))

(define-syntax amb
  (syntax-rules ()
    ((amb) (fail))
    ((amb expr) expr)
    ((amb expr ...)
      (let ((prev-fail fail))
        ((call-with-current-continuation
          (lambda (success)
            (call-with-current-continuation
              (lambda (failure)
                (set! fail failure)
                (success (lambda () expr))))
            ...
            (set! fail prev-fail)
            prev-fail)))))))

(define (require condition)
  (if (not condition) (amb)))

(define (distinct? xs)
  (cond ((null? xs) #t)
        ((member (car xs) (cdr xs)) #f)
        (else (distinct? (cdr xs)))))

(define (multiple-dwelling)
  (let ((baker    (amb 1 2 3 4 5))
        (cooper   (amb 1 2 3 4 5))
        (fletcher (amb 1 2 3 4 5))
        (miller   (amb 1 2 3 4 5))
        (smith    (amb 1 2 3 4 5)))
    (require (distinct? (list baker cooper fletcher miller smith)))
    (require (not (= baker 5)))
    (require (not (= cooper 1)))
    (require (not (= fletcher 5)))
    (require (not (= fletcher 1)))
    (require (> miller cooper))
    (require (not (= (abs (- smith fletcher)) 1)))
    (require (not (= (abs (- fletcher cooper)) 1)))
    (list (list 'baker baker)
          (list 'cooper cooper)
          (list 'fletcher fletcher)
          (list 'miller miller)
          (list 'smith smith))))

(display (multiple-dwelling))

Private [?]

Run code