src/sicp/amb-eli.rkt

   1 #lang racket
   2 (provide amb assert collect)
   3
   4 (define failures null)
   5
   6 (define (fail)
   7   (if (pair? failures)
   8       ((first failures))
   9       (error "no more choices!")))
  10
  11 (define (amb/thunks choices)
  12   (let/cc k (set! failures (cons k failures)))
  13   (if (pair? choices)
  14       (let ([choice (first choices)])
  15         (set! choices (rest choices))
  16         (choice))
  17       (begin (set! failures (rest failures))
  18              (fail))))
  19
  20 (define-syntax-rule (amb E ...)
  21   (amb/thunks (list (lambda () E) ...)))
  22
  23 (define (assert condition)
  24   (unless condition (fail)))
  25
  26 (define (collect/thunk n thunk)
  27   (define results null)
  28   (let/cc too-few
  29     (set! failures (list too-few))
  30     (define result (thunk))
  31     (set! results (cons result results))
  32     (set! n (sub1 n))
  33     (unless (zero? n) (fail)))
  34   (set! failures null)
  35   (reverse results))
  36
  37 (define-syntax collect
  38   (syntax-rules ()
  39     ;; collect N results
  40     [(_ N E) (collect/thunk N (lambda () E))]
  41     ;; collect all results
  42     [(_ E) (collect/thunk -1 (lambda () E))]))