condp.scm

(define-syntax prefix-sum
  (syntax-rules ()
    ((_ ((pvar ps) ...) body)
     (prefix-sum* ((pvar ps) ...) 0 body))))

(define-syntax prefix-sum*
  (syntax-rules ()
    ((_ () acc body) body)
    ((_ ((pvar ps) (pvar* ps*) ...) acc body)
     (let ((pvar (+ ps acc)))
       (prefix-sum* ((pvar* ps*) ...) pvar body)))))

(define-syntax condp
  (lambda (x)
    (syntax-case x ()
      ((_ (e0 g0 g ...) ...)
       (with-syntax ([(np0 ...) (generate-temporaries #'(e0 ...))])
         #'(lambdag@ (c)
             (let ((sum-ps (exact->inexact (+ e0 ...))))
               (prefix-sum ((np0 (/ e0 sum-ps)) ...)
                 ((fresh ()
                   alwayso
                   (lambdag@ (c^)
                     (let ((rn (random 1.0)))
                       (let ((f (lambda (y)
                                  (if (< rn y)
                                      succeed
                                      fail))))
                         ((condu
                            ((f np0) g0 g ...)
                            ...)
                          c^)))))
                  c)))))))))

; example

(run 1 (q)
  (condp
    [100 (== 1 q)]
    [100 (== 2 q)]
    [1 (== 3 q)]))