added "autorequire"; preparing libraries for autorequire
[k8-xscheme:k8-xscheme.git] / lib / tests / amb_test2.scm
1 (amb:init)
2
3
4 (define (choose-color)
5   (amb 'red 'yellow 'blue 'white))
6
7
8 (define (color-europe)
9   ;choose colors for each country
10   (let ([p (choose-color)] ;Portugal
11         [e (choose-color)] ;Spain
12         [f (choose-color)] ;France
13         [b (choose-color)] ;Belgium
14         [h (choose-color)] ;Holland
15         [g (choose-color)] ;Germany
16         [l (choose-color)] ;Luxemb
17         [i (choose-color)] ;Italy
18         [s (choose-color)] ;Switz
19         [a (choose-color)]);Austria
20     ;construct the adjacency list for
21     ;each country: the 1st element is
22     ;the name of the country; the 2nd
23     ;element is its color; the 3rd
24     ;element is the list of its
25     ;neighbors' colors
26     (let ([portugal (list 'portugal p (list e))]
27           [spain (list 'spain e (list f p))]
28           [france (list 'france f (list e i s b g l))]
29           [belgium (list 'belgium b (list f h l g))]
30           [holland (list 'holland h (list b g))]
31           [germany (list 'germany g (list f a s h b l))]
32           [luxembourg (list 'luxembourg l (list f b g))]
33           [italy (list 'italy i (list f a s))]
34           [switzerland (list 'switzerland s (list f i a g))]
35           [austria (list 'austria a (list i s g))])
36       (let ([countries
37              (list portugal spain
38                    france belgium
39                    holland germany
40                    luxembourg
41                    italy switzerland
42                    austria)])
43         ;the color of a country
44         ;should not be the color of
45         ;any of its neighbors
46         (for-each (lambda (c) (amb:require (not (memq (cadr c) (caddr c)))))
47                   countries)
48         ;output the color
49         ;assignment
50         (for-each (lambda (c) (format #t "~d ~d\n" (car c) (cadr c)))
51                   countries)))))
52
53 ;Type (color-europe) to get a color assignment.
54 (color-europe)