source: project/release/3/amb/amb-demo.html @ 18200

Last change on this file since 18200 was 435, checked in by Thomas Chust, 14 years ago

[amb] made the egg fit for -check-imports

File size: 2.2 KB
Line 
1<!DOCTYPE html PUBLIC "-//IETF//DTD HTML 2.0//EN">
2<HTML>
3<HEAD>
4<TITLE>Enscript Output</TITLE>
5</HEAD>
6<BODY BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#1F00FF" ALINK="#FF0000" VLINK="#9900DD">
7<A NAME="top">
8<A NAME="file1">
9<H1>amb-demo.scm</H1>
10
11<PRE>
12<I><FONT COLOR="#B22222">;;;; amb-demo.scm
13</FONT></I><I><FONT COLOR="#B22222">;;;; A solution for the Kalotan puzzle using amb
14</FONT></I>
15(require-extension amb)
16
17(<B><FONT COLOR="#A020F0">define</FONT></B> (<B><FONT COLOR="#0000FF">xor</FONT></B> a? b?)
18  (<B><FONT COLOR="#A020F0">if</FONT></B> (<B><FONT COLOR="#A020F0">and</FONT></B> a? b?) #f (<B><FONT COLOR="#A020F0">or</FONT></B> a? b?)))
19
20(<B><FONT COLOR="#A020F0">define</FONT></B> (<B><FONT COLOR="#0000FF">solve-kalotan-puzzle</FONT></B>)
21  (<B><FONT COLOR="#A020F0">let</FONT></B> ((parent1 (amb 'm 'f))
22        (parent2 (amb 'm 'f))
23        (kibi (amb 'm 'f))
24        (kibi-self-desc (amb 'm 'f))
25        (kibi-lied? (amb #t #f)))
26    (amb-assert
27     (not (eq? parent1 parent2)))
28    (<B><FONT COLOR="#A020F0">if</FONT></B> kibi-lied?
29        (amb-assert
30         (xor
31          (<B><FONT COLOR="#A020F0">and</FONT></B> (eqv? kibi-self-desc 'm)
32               (eqv? kibi 'f))
33          (<B><FONT COLOR="#A020F0">and</FONT></B> (eqv? kibi-self-desc 'f)
34               (eqv? kibi 'm)))))
35    (<B><FONT COLOR="#A020F0">if</FONT></B> (not kibi-lied?)
36        (amb-assert
37         (xor
38          (<B><FONT COLOR="#A020F0">and</FONT></B> (eqv? kibi-self-desc 'm)
39               (eqv? kibi 'm))
40          (<B><FONT COLOR="#A020F0">and</FONT></B> (eqv? kibi-self-desc 'f)
41               (eqv? kibi 'f)))))
42    (<B><FONT COLOR="#A020F0">if</FONT></B> (eqv? parent1 'm)
43        (amb-assert
44         (<B><FONT COLOR="#A020F0">and</FONT></B>
45          (eqv? kibi-self-desc 'm)
46          (xor
47           (<B><FONT COLOR="#A020F0">and</FONT></B> (eqv? kibi 'f)
48                (eqv? kibi-lied? #f))
49           (<B><FONT COLOR="#A020F0">and</FONT></B> (eqv? kibi 'm)
50                (eqv? kibi-lied? #t))))))
51    (<B><FONT COLOR="#A020F0">if</FONT></B> (eqv? parent1 'f)
52        (amb-assert
53         (<B><FONT COLOR="#A020F0">and</FONT></B>
54          (eqv? kibi 'f)
55          (eqv? kibi-lied? #t))))
56    (list parent1 parent2 kibi)))
57
58(write (amb-collect (solve-kalotan-puzzle)))
59(newline)
60</PRE>
61<HR>
62<ADDRESS>Generated by <A HREF="http://www.iki.fi/~mtr/genscript/">GNU enscript 1.6.1</A>.</ADDRESS>
63</BODY>
64</HTML>
Note: See TracBrowser for help on using the repository browser.