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

Color European Countries

(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))
       (call/cc 
         (lambda (sk)
           (call/cc 
             (lambda (fk)
               (set! amb-fail (lambda () (fk 'fail)))
               (sk x)))
           ...
           (prev-level)))))))

;; (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

;; (choose-color) - one of 'red 'yellow 'blue 'green
;;
(define choose-color
  (lambda ()
    (amb 'red 'yellow 'blue 'green)))

;; Color the european countries
;;
(define color-europe
  (lambda ()

    (letrec
      ((printresult
         (lambda (c)
           (if (null? c)
               '()
               (cons (cons (caar c) (cadar c)) 
                     (printresult (cdr c)))))))
      (let*

         ;; choose colors for each country
        ((p (choose-color))  ;Portugal
         (e (choose-color))  ;Spain
         (f (choose-color))  ;France
         (b (choose-color))  ;Belgium
         (h (choose-color))  ;Holland
         (g (choose-color))  ;Germany
         (l (choose-color))  ;Luxemb.
         (i (choose-color))  ;Italy
         (s (choose-color))  ;Switz.
         (a (choose-color))  ;Austria

         ;; construct the adjacency list for each 
         ;; country: the 1st element is the name 
         ;; of the country; the 2nd element is its 
         ;; color; the 3rd element is the list of 
         ;; its neighbors' colors
         (portugal 
           (list 'portugal p (list e)))
         (spain 
           (list 'spain e (list f p)))
         (france 
           (list 'france f (list e i s b g l)))
         (belgium 
           (list 'belgium b (list f h l g)))
         (holland 
           (list 'holland h (list b g)))
         (germany 
           (list 'germany g (list f a s h b l)))
         (luxembourg 
           (list 'luxembourg l (list f b g)))
         (italy 
           (list 'italy i (list f a s)))
         (switzerland 
           (list 'switzerland s (list f i a g)))
         (austria 
           (list 'austria a (list i s g)))

         (countries
           (list portugal spain france belgium
                 holland germany luxembourg
                 italy switzerland austria)))

      ;; the color of a country should not be the 
      ;; color of any of its neighbors
      (for-each
        (lambda (c)
          (assert (not (memq (cadr c) (caddr c)))))
        countries)

      (printresult countries)))))
 -  Assign colors to countries in Europe so that no two bordering countries are assigned the same color. Runit like this:
 prompt> (color-europe)
The result looks like this:
 ;Value 11: ((portugal . red) (spain . yellow) 
 (france . red) (belgium . yellow) (holland . red) 
 (germany . blue) (luxembourg . green) (italy . yellow) 
 (switzerland . green) (austria . red))