20-CS-4003-001 Organization of Programming Languages Fall 2017
Call-with-current-continuation examples

Lambda calculus, Type theory, Formal semantics, Program analysis

    Prev     Next     All lectures        Code

Logic Puzzle

(define call/cc call-with-current-continuation)

;; Implementation of amb
(define amb-fail (lambda () (error 'no-solution)))

(define-syntax amb
  (syntax-rules ()
    ((amb x ...)
     (let ((prev-level amb-fail))
         (lambda (sk)
             (lambda (fk)
               (set! amb-fail (lambda () (fk 'fail)))
               (sk x)))

;; (assert pred) - forces pred to be true
(define assert (lambda (p) (if (not p) (amb))))

;; ---------------------------------------------------
;; All code above this line may be used in other
;; programs

;; (distinct? lst) - #t iff all objects in lst are different
(define distinct?
  (lambda (l)
    (if (or (null? l) (null? (cdr l)))
             (lambda (l^ token)
               (if (null? l^)
                   (if (eq? token (car l^))
                       (is-there? (cdr l^) token))))))
          (if (is-there? (cdr l) (car l))
              (distinct? (cdr l)))))))

;; Solution to the puzzle using "amb"
(define puzzle
 (lambda ()
    ((house_red (amb 'swede 'dane 'german 'brit 'norge))
     (house_wht (amb 'swede 'dane 'german 'brit 'norge))
     (house_grn (amb 'swede 'dane 'german 'brit 'norge))
     (house_blu (amb 'swede 'dane 'german 'brit 'norge))
     (house_yel (amb 'swede 'dane 'german 'brit 'norge)))
   (assert (eq? house_red 'brit))
         house_red house_wht house_grn house_blu house_yel)))
     ((posit_one (amb 'swede 'dane 'german 'brit 'norge))
      (posit_two (amb 'swede 'dane 'german 'brit 'norge))
      (posit_thr (amb 'swede 'dane 'german 'brit 'norge))
      (posit_fou (amb 'swede 'dane 'german 'brit 'norge))
      (posit_fve (amb 'swede 'dane 'german 'brit 'norge)))
     (assert (or (and (eq? posit_one house_blu)
                      (eq? posit_two 'norge))
                 (and (eq? posit_two house_blu)
                      (or (eq? posit_one 'norge)
                          (eq? posit_thr 'norge)))
                 (and (eq? posit_thr house_blu)
                      (or (eq? posit_two 'norge)
                          (eq? posit_fou 'norge)))
                 (and (eq? posit_fou house_blu)
                      (or (eq? posit_thr 'norge)
                          (eq? posit_fve 'norge)))
                 (and (eq? posit_fve house_blu)
                      (eq? posit_fou 'norge))))
     (assert (or (eq? posit_one 'norge)
                 (eq? posit_fve 'norge)))
     (assert (or (and (eq? posit_one house_grn)
                      (or (eq? posit_two house_wht)
                          (eq? posit_thr house_wht)
                          (eq? posit_fou house_wht)
                          (eq? posit_fve house_wht)))
                 (and (eq? posit_two house_grn)
                      (or (eq? posit_thr house_wht)
                          (eq? posit_fou house_wht)
                          (eq? posit_fve house_wht)))
                 (and (eq? posit_thr house_grn)
                      (or (eq? posit_fou house_wht)
                          (eq? posit_fve house_wht)))
                 (and (eq? posit_fou house_grn)
                      (eq? posit_fve house_wht))))
           posit_one posit_two posit_thr posit_fou posit_fve)))
       ((pet_dog (amb 'swede 'dane 'german 'brit 'norge))
        (pet_cat (amb 'swede 'dane 'german 'brit 'norge))
        (pet_hrs (amb 'swede 'dane 'german 'brit 'norge))
        (pet_fsh (amb 'swede 'dane 'german 'brit 'norge))
        (pet_brd (amb 'swede 'dane 'german 'brit 'norge)))
       (assert (eq? pet_dog 'swede))
           (list pet_dog pet_cat pet_brd pet_fsh pet_hrs)))
         ((smoke_pml (amb 'swede 'dane 'german 'brit 'norge))
          (smoke_dun (amb 'swede 'dane 'german 'brit 'norge))
          (smoke_blu (amb 'swede 'dane 'german 'brit 'norge))
          (smoke_bnd (amb 'swede 'dane 'german 'brit 'norge))
          (smoke_prn (amb 'swede 'dane 'german 'brit 'norge)))
         (assert (eq? smoke_prn 'german))
         (assert (eq? smoke_dun house_yel))
         (assert (eq? smoke_pml pet_brd))
            smoke_pml smoke_dun smoke_blu smoke_bnd smoke_prn)))
                 (if (eq? smoke_bnd 'german) 'german
                     (if (eq? smoke_bnd 'norge) 'norge
                         (if (eq? smoke_bnd 'dane) 'dane
                             (if (eq? smoke_bnd 'brit) 'brit
                 (if (eq? pet_cat 'german) 'german
                     (if (eq? pet_cat 'norge) 'norge
                         (if (eq? pet_cat 'dane) 'dane
                             (if (eq? pet_cat 'brit) 'brit
             (or (and (eq? posit_one smoker)
                      (eq? posit_two petter))
                 (and (eq? posit_two smoker)
                      (or (eq? posit_one petter)
                          (eq? posit_thr petter)))
                 (and (eq? posit_thr smoker)
                      (or (eq? posit_two petter)
                          (eq? posit_fou petter)))
                 (and (eq? posit_fou smoker)
                      (or (eq? posit_thr petter)
                          (eq? posit_fve petter)))
                 (and (eq? posit_fve smoker)
                      (eq? posit_fou petter)))))
                  (amb 'swede 'dane 'german 'brit 'norge))
                  (amb 'swede 'dane 'german 'brit 'norge))
                  (amb 'swede 'dane 'german 'brit 'norge))
                  (amb 'swede 'dane 'german 'brit 'norge))
                  (amb 'swede 'dane 'german 'brit 'norge)))
               (assert (eq? posit_thr drink_mlk))
               (assert (eq? drink_tea 'dane))
               (assert (eq? smoke_blu drink_ber))
               (assert (eq? house_grn drink_cof))
                  drink_tea drink_cof drink_mlk drink_ber drink_wat)))
                      (if (eq? smoke_bnd 'german) 'german
                          (if (eq? smoke_bnd 'norge) 'norge
                              (if (eq? smoke_bnd 'dane) 'dane
                                  (if (eq? smoke_bnd 'brit) 'brit
                      (if (eq? drink_wat 'german) 'german
                          (if (eq? drink_wat 'norge) 'norge
                              (if (eq? drink_wat 'dane) 'dane
                                  (if (eq? drink_wat 'brit) 'brit
                   (or (and (eq? posit_one smoker)
                            (eq? posit_two drinker))
                       (and (eq? posit_two smoker)
                            (or (eq? posit_one drinker)
                                (eq? posit_thr drinker)))
                       (and (eq? posit_thr smoker)
                            (or (eq? posit_two drinker)
                                (eq? posit_fou drinker)))
                       (and (eq? posit_fou smoker)
                            (or (eq? posit_thr drinker)
                                (eq? posit_fve drinker)))
                       (and (eq? posit_fve smoker)
                            (eq? posit_fou drinker)))))

                (list 'Houses: 'red= house_red
                               'green= house_grn
                               'yellow= house_yel
                               'blue= house_blu
                               'white= house_wht)
                (list 'Smokes: 'dunhill= smoke_dun
                               'prince= smoke_prn
                               'blend= smoke_bnd
                               'pall-mall= smoke_pml
                               'blue= smoke_blu)
                (list 'Pets:   'fish= pet_fsh
                               'dog= pet_dog
                               'cat= pet_cat
                               'horse= pet_hrs
                               'birds= pet_brd)
                (list 'Drinks: 'water= drink_wat
                               'beer= drink_ber
                               'coffee= drink_cof
                               'tea= drink_tea
                               'milk= drink_mlk)
                (list 'Position: '1= posit_one
                                 '2= posit_two
                                 '3= posit_thr
                                 '4= posit_fou
                                 '5= posit_fve)))))))))
 -  No owners have the same pet, smoke the same brand of cigar or drink the same beverage. The question is: Who owns the fish?
* the Brit lives in the red house
* the Swede keeps dogs as pets
* the Dane drinks tea
* the green house is on the left of the white house
* the green house's owner drinks coffee
* the person who smokes Pall Mall rears birds
* the owner of the yellow house smokes Dunhill
* the man living in the center house drinks milk
* the Norwegian lives in the first house
* the man who smokes blends lives next to the one who keeps cats
* the man who keeps horses lives next to the man who smokes Dunhill
* the owner who smokes BlueMaster drinks beer
* the German smokes Prince
* the Norwegian lives next to the blue house
* the man who smokes blend has a neighbor who drinks water