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

(declare
  (usual-integrations)
  (fixnum-arithmetic)
  (inline)
  (local)
  (no-procedure-checks))

;;; Module `amb'
  
(require-library data-structures extras amb)

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

(import scheme chicken data-structures extras amb)

;;

(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)
  (cond ((null? xs) #t)
        ((member (car xs) (cdr xs)) #f)
        (else (distinct? (cdr xs)))))

) ;module amb-extras