[ create a new paste ] login | about

Link: http://codepad.org/DsQGNTC2    [ raw code | output | fork ]

Scheme, pasted on Jun 14:
(define call/cc call-with-current-continuation)

(define-syntax let/cc
  (syntax-rules ()
    ((_ k body ...) (call/cc (lambda (k) body ...)))))

(define-syntax push!
  (syntax-rules ()
    ((_ stack x) (begin (set! stack (cons x stack)) x))))

(define-syntax pop!
  (syntax-rules ()
    ((_ stack) (let ((x (car stack))) (set! stack (cdr stack)) x))))

(define-syntax let/amb
  (syntax-rules ()
    ((_ amb body ...)
     (let/cc k
       (let ((stack (list k)))
         (let-syntax
           ((amb
              (syntax-rules ()
                ((_ x (... ...))
                 (let/cc yield
                   (let/cc fallthrough
                     (push! stack fallthrough)
                     (yield x))
                   (... ...)
                   ((pop! stack)))))))
           body ...))))))

(let ((xs '()))
  (let/amb amb
    (let ((x (amb 0 1)) (y (amb 0 1)) (z (amb 0 1)))
      (push! xs (list x y z))
      (amb)))
  (display (reverse xs)))


Output:
1
((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1))


Create a new paste based on this one


Comments: