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

(module amb-extras

(;export
  (amb1 list-thunkify)
  (choose random list-thunkify)
  one-of
  all-of
  required
  implies
  distinct?
  ;
  count-member)

(import scheme)

(import chicken)
(import
  (only extras random)
  (only data-structures sort!))

(import (only (srfi 1) count))
(require-library (srfi 1))

(import (only type-checks check-list check-procedure))
(require-library type-checks)

(require-extension amb)

;;;

;;

(define-syntax amb1
  (syntax-rules ()
    ((_)
     ((amb-failure-continuation)) )
    ((_ ?ls)
     (amb-thunks (list-thunkify ?ls)) ) ) )

(define-syntax choose
  (syntax-rules ()
     ((_)
     ((amb-failure-continuation)) )
   ((_ ?ls)
      (amb-thunks-shuffled (list-thunkify ?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 (implies a b)
  (or (not a) b) )

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

;;;

;;

(define (count-member x xs #!optional (eql? equal?))
  (count (cut eql? x <>) xs) )

(define (list-thunkify ls)
  (map (lambda (x) (lambda () x)) ls) )

) ;module amb-extras