;;;; amb-extras.scm
;;;; Kon Lovett, Mar '09

;;; Module `amb'

(module amb-extras

  (;export
    choose
    one-of
    all-of
    required
    distinct?)

  (import scheme
          chicken
          (only data-structures shuffle)
          (only extras random)
          amb
          (only type-checks check-list check-procedure))

  (require-library data-structures extras amb type-checks)

;;

(define-syntax choose
  (syntax-rules ()
    ((_ ?ls) (amb-thunks (map (lambda (x) (lambda () x)) (shuffle ?ls random))) ) ) )

(define-syntax one-of
  (syntax-rules ()
    ((_ ?expr) (amb-find ?expr) ) ) )

(define-syntax all-of
  (syntax-rules ()
    ((_ ?expr) (amb-collect ?expr) ) ) )

(define-syntax required
  (syntax-rules ()
    ((_ ?expr) (amb-assert ?expr) ) ) )

(define (distinct? xs #!optional (eql? equal?))
  (check-list 'distinct? xs 'list)
  (check-procedure 'distinct? eql? 'equivalence)
  (let loop ((xs xs))
    (or (null? xs)
        (and (not (member (car xs) (cdr xs) eql?))
             (loop (cdr xs)))) ) )

) ;module amb-extras