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

(module amb-extras

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

(import scheme)

(import chicken)

(import
  (only extras random)
  (only data-structures sort! constantly))
(require-library extras data-structures)

(import (only (srfi 1) count every))
(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-constantly ?ls)) ) ) )

(define-syntax choose
  (syntax-rules ()
    ((_)
     ((amb-failure-continuation)) )
    ((_ ?ls)
      (amb-thunks-shuffled (list-constantly ?ls) (amb-random-function)) ) ) )

(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-procedure 'distinct? eql? '=?)
  (every
    (lambda (t) (fx= 1 (count-member t xs eql?)))
    (check-list 'distinct? xs 'list)) )

;;;

;;

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

(define (list-constantly ls)
  (map constantly ls) )

) ;module amb-extras