[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/NIkMrLqf    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Jul 29:
; send + more = money

(define (fail)
  (error 'amb "tree exhausted"))

(define-syntax amb
  (syntax-rules ()
    ((amb) (fail))
    ((amb expr) expr)
    ((amb expr ...)
      (let ((prev-fail fail))
        ((call-with-current-continuation
          (lambda (success)
            (call-with-current-continuation
              (lambda (failure)
                (set! fail failure)
                (success (lambda () expr))))
            ...
            (set! fail prev-fail)
            prev-fail)))))))

(define (require condition)
  (if (not condition) (amb)))

(define (distinct? xs)
  (cond ((null? xs) #t)
        ((member (car xs) (cdr xs)) #f)
        (else (distinct? (cdr xs)))))

(define (send-more-money)
  (call-with-current-continuation
    (lambda (return)
      (do ((s 1 (+ s 1))) ((= s 10))
        (do ((e 0 (+ e 1))) ((= e 10))
          (do ((n 0 (+ n 1))) ((= n 10))
            (do ((d 0 (+ d 1))) ((= d 10))
              (do ((m 1 (+ m 1))) ((= m 10))
                (do ((o 0 (+ o 1))) ((= o 10))
                  (do ((r 0 (+ r 1))) ((= r 10))
                    (do ((y 0 (+ y 1))) ((= y 10))
                      (when (and (distinct? (list s e n d m o r y))
                                 (= (+ (* 1000 s) (* 100 e) (* 10 n) d
                                       (* 1000 m) (* 100 o) (* 10 r) e)
                                    (+ (* 10000 m) (* 1000 o) (* 100 n) (* 10 e) y)))
                        (return (list (list s e n d) (list m o r e) (list m o n e y)))))))))))))))

(display (send-more-money)) (newline)

(define (send-more-money)
  (let ((s (amb   1 2 3 4 5 6 7 8 9))
        (e (amb 0 1 2 3 4 5 6 7 8 9))
        (n (amb 0 1 2 3 4 5 6 7 8 9))
        (d (amb 0 1 2 3 4 5 6 7 8 9))
        (m (amb   1 2 3 4 5 6 7 8 9))
        (o (amb 0 1 2 3 4 5 6 7 8 9))
        (r (amb 0 1 2 3 4 5 6 7 8 9))
        (y (amb 0 1 2 3 4 5 6 7 8 9)))
    (require (distinct? (list s e n d m o r y)))
    (require (=                (amb 0 1)      m))
    (require (= (modulo (+ s m (amb 0 1)) 10) o))
    (require (= (modulo (+ e o (amb 0 1)) 10) n))
    (require (= (modulo (+ n r (amb 0 1)) 10) e))
    (require (= (modulo (+ d e (amb 0 1)) 10) y))
    (require (= (+             (* 1000 s) (* 100 e) (* 10 n) d
                               (* 1000 m) (* 100 o) (* 10 r) e)
                (+ (* 10000 m) (* 1000 o) (* 100 n) (* 10 e) y)))
    (list (list s e n d) (list m o r e) (list m o n e y))))

(display (send-more-money)) (newline)


Output:
1
Timeout


Create a new paste based on this one


Comments: