Moving examples to tests

collects/tests/schelog/bible.rkt

@@ -0,0 +1,130 @@
+#lang racket
+
+(require schelog
+         schemeunit)
+
+;The following is the "Biblical" database from "The Art of
+;Prolog", Sterling & Shapiro, ch. 1.
+
+;(%father X Y) :- X is the father of Y.
+
+(define %father
+  (%rel ()
+    (('terach 'abraham)) (('terach 'nachor)) (('terach 'haran))
+    (('abraham 'isaac)) (('haran 'lot)) (('haran 'milcah))
+    (('haran 'yiscah))))
+
+;(%mother X Y) :- X is the mother of Y.
+
+(define %mother
+  (%rel () (('sarah 'isaac))))
+
+(define %male
+  (%rel ()
+    (('terach)) (('abraham)) (('isaac)) (('lot)) (('haran)) (('nachor))))
+
+(define %female
+  (%rel ()
+    (('sarah)) (('milcah)) (('yiscah))))
+
+;AoP, ch. 17.  Finding all the children of a particular
+;father.  (%children F CC) :- CC is the list of children
+;whose father is F.  First approach: %children-1 uses an
+;auxiliary predicate %children-aux, which uses an
+;accumulator.
+
+(define %children-1
+
+  (letrec ((children-aux
+	     (%rel (x a cc c)
+	       ((x a cc)
+                 (%father x c) (%not (%member c a)) !
+                 (children-aux x (cons c a) cc))
+	       ((x cc cc)))))
+
+    (%rel (x cc)
+      ((x cc) (children-aux x '() cc)))))
+
+(define terachs-kids-test
+  ;find all the children of Terach.  Returns
+  ;cc = (abraham nachor haran)
+  (lambda ()
+    (%which (cc)
+      (%children-1 'terach cc))))
+
+(check-equal? (terachs-kids-test)
+              `((cc (haran nachor abraham))))
+
+(define dad-kids-test
+  ;find a father and all his children.  Returns
+  ;f = terach, cc = (haran nachor abraham).
+  ;(%more) fails, showing flaw in %children-1.
+  ;see AoP, ch. 17, p. 267
+  (lambda ()
+    (%which (f cc)
+      (%children-1 f cc))))
+
+(check-equal? (dad-kids-test)
+              `((f terach) (cc (haran nachor abraham))))
+
+(define terachs-kids-test-2
+  ;find all the kids of Terach, using %set-of.
+  ;returns kk = (abraham nachor haran)
+  (lambda ()
+    (%let (k)
+      (%which (kk)
+        (%set-of k (%father 'terach k) kk)))))
+
+;This is a better definition of the %children predicate.
+;Uses set predicate %bag-of
+
+(define %children
+  (%rel (x kids c)
+    ((kids) (%set-of c (%father x c) kids))))
+
+(define dad-kids-test-2
+  ;find each dad-kids combo.
+  ;1st soln: dad = terach, kids = (abraham nachor haran)
+  ;(%more) gives additional solutions.
+  (lambda ()
+    (%let (x)
+      (%which (dad kids)
+        (%set-of x (%free-vars (dad)
+                     (%father dad x))
+          kids)))))
+
+(define dad-kids-test-3
+  ;looks like dad-kids-test-2, but dad is now
+  ;existentially quantified.  returns a set of
+  ;kids (i.e., anything with a father)
+  (lambda ()
+    (%let (x)
+      (%which (dad kids)
+        (%set-of x (%father dad x)
+          kids)))))
+
+(define dad-kids-test-4
+  ;find the set of dad-kids.
+  ;since dad is existentially quantified,
+  ;this gives the wrong answer: it gives
+  ;one set containing all the kids
+  (lambda ()
+    (%let (dad kids x)
+      (%which (dad-kids)
+	(%set-of (list dad kids)
+	  (%set-of x (%father dad x) kids)
+	  dad-kids)))))
+
+(define dad-kids-test-5
+  ;the correct solution.  dad is
+  ;identified as a free var.
+  ;returns a set of dad-kids, one for
+  ;each dad
+  (lambda ()
+    (%let (dad kids x)
+      (%which (dad-kids)
+	(%set-of (list dad kids)
+	  (%set-of x (%free-vars (dad)
+                       (%father dad x))
+            kids)
+	  dad-kids)))))

collects/tests/schelog/england.rkt

@@ -0,0 +1,57 @@
+#lang racket
+
+(require schelog
+         schemeunit)
+
+;The following is a simple database about a certain family in England.
+;Should be a piece of cake, but given here so that you can hone
+;your ability to read the syntax.
+
+;This file is written using `%rel' for a more Prolog-like syntax.
+;The file england2.scm uses a Scheme-like syntax.
+
+(define %male
+  (%rel ()
+    (('philip)) (('charles)) (('andrew)) (('edward))
+    (('mark)) (('william)) (('harry)) (('peter))))
+
+(define %female
+  (%rel ()
+    (('elizabeth)) (('anne)) (('diana)) (('sarah)) (('zara))))
+
+(define %husband-of
+  (%rel ()
+    (('philip 'elizabeth)) (('charles 'diana))
+    (('mark 'anne)) (('andrew 'sarah))))
+
+(define %wife-of
+  (%rel (w h)
+    ((w h) (%husband-of h w))))
+
+(define %married-to
+  (%rel (x y)
+    ((x y) (%husband-of x y))
+    ((x y) (%wife-of x y))))
+
+(define %father-of
+  (%rel ()
+   (('philip 'charles)) (('philip 'anne)) (('philip 'andrew))
+   (('philip 'edward)) (('charles 'william)) (('charles 'harry))
+   (('mark 'peter)) (('mark 'zara))))
+
+(define %mother-of
+  (%rel (m c f)
+    ((m c) (%wife-of m f) (%father-of f c))))
+
+(define %child-of
+  (%rel (c p)
+    ((c p) (%father-of p c))
+    ((c p) (%mother-of p c))))
+
+(define %parent-of
+  (%rel (p c)
+    ((p c) (%child-of c p))))
+
+(define %brother-of
+  (%rel (b x f)
+    ((b x) (%male b) (%father-of f b) (%father-of f x) (%/= b x))))

collects/tests/schelog/england2.rkt

@@ -0,0 +1,78 @@
+#lang racket
+
+(require schelog)
+
+;The following is a simple database about a certain family in England.
+;Should be a piece of cake, but given here so that you can hone
+;your ability to read the syntax.
+
+;This file is written using goal combinations like %or, %and
+;like you would use Scheme procedures.  For a more Prolog-like
+;syntax of the same program, see england.scm.
+
+(define %male
+  (lambda (x)
+    (%or (%= x 'philip)
+	 (%= x 'charles)
+	 (%= x 'andrew)
+	 (%= x 'edward)
+	 (%= x 'mark)
+	 (%= x 'william)
+	 (%= x 'harry)
+	 (%= x 'peter))))
+
+(define %female
+  (lambda (x)
+    (%or (%= x 'elizabeth)
+	 (%= x 'anne)
+	 (%= x 'diana)
+	 (%= x 'sarah)
+	 (%= x 'zara))))
+
+(define %husband-of
+  (lambda (h w)
+    (%or (%and (%= h 'philip) (%= w 'elizabeth))
+	 (%and (%= h 'charles) (%= w 'diana))
+	 (%and (%= h 'mark) (%= w 'anne))
+	 (%and (%= h 'andrew) (%= w 'sarah)))))
+
+(define %wife-of
+  (lambda (w h)
+    (%husband-of h w)))
+
+(define %married-to
+  (lambda (x y)
+    (%or (%husband-of x y) (%wife-of x y))))
+
+(define %father-of
+  (lambda (x y)
+    (%or (%and (%= x 'philip) (%= y 'charles))
+	 (%and (%= x 'philip) (%= y 'anne))
+	 (%and (%= x 'philip) (%= y 'andrew))
+	 (%and (%= x 'philip) (%= y 'edward))
+	 (%and (%= x 'charles) (%= y 'william))
+	 (%and (%= x 'charles) (%= y 'harry))
+	 (%and (%= x 'mark) (%= y 'peter))
+	 (%and (%= x 'mark) (%= y 'zara)))))
+
+(define %mother-of
+  (lambda (m c)
+    (%let (f)
+      (%and (%wife-of m f) (%father-of f c)))))
+
+(define %child-of
+  (lambda (c p)
+    (%or (%father-of p c) (%mother-of p c))))
+
+(define %parent-of
+  (lambda (p c)
+    (%child-of c p)))
+
+(define %brother-of
+  (lambda (b x)
+    (%let (f)
+      (%and (%male b)
+	    (%father-of f b)
+	    (%father-of f x)
+	    (%/= b x)))))
+

collects/tests/schelog/games.rkt

@@ -0,0 +1,92 @@
+#lang racket
+
+(require schelog
+         "./puzzle.rkt"
+         schemeunit)
+
+;;This example is from Sterling & Shapiro, p. 214.
+;;
+;;The problem reads: Three friends came first, second and
+;;third in a competition.  Each had a different name, liked a
+;;different sport, and had a different nationality.  Michael
+;;likes basketball, and did better than the American.  Simon,
+;;the Israeli, did better than the tennis player.  The
+;;cricket player came first.  Who's the Australian?  What
+;;sport does Richard play?
+
+(define person
+  ;;a structure-builder for persons
+  (lambda (name country sport)
+    (list 'person name country sport)))
+
+(define %games
+  (%rel (clues queries solution the-men
+	 n1 n2 n3 c1 c2 c3 s1 s2 s3)
+    ((clues queries solution)
+     (%= the-men
+       (list (person n1 c1 s1) (person n2 c2 s2) (person n3 c3 s3)))
+     (%games-clues the-men clues)
+     (%games-queries the-men queries solution))))
+    
+(define %games-clues
+  (%rel (the-men clue1-man1 clue1-man2 clue2-man1 clue2-man2 clue3-man)
+    ((the-men
+       (list
+	 (%did-better clue1-man1 clue1-man2 the-men)
+	 (%name clue1-man1 'michael)
+	 (%sport clue1-man1 'basketball)
+	 (%country clue1-man2 'usa)
+
+	 (%did-better clue2-man1 clue2-man2 the-men)
+	 (%name clue2-man1 'simon)
+	 (%country clue2-man1 'israel)
+	 (%sport clue2-man2 'tennis)
+
+	 (%first the-men clue3-man)
+	 (%sport clue3-man 'cricket))))))
+
+(define %games-queries
+  (%rel (the-men man1 man2 aussies-name dicks-sport)
+    ((the-men
+       (list
+	 (%member man1 the-men)
+	 (%country man1 'australia)
+	 (%name man1 aussies-name)
+
+	 (%member man2 the-men)
+	 (%name man2 'richard)
+	 (%sport man2 dicks-sport))
+       (list
+	 (list aussies-name 'is 'the 'australian)
+	 (list 'richard 'plays dicks-sport))))))
+	 
+(define %did-better
+  (%rel (a b c)
+    ((a b (list a b c)))
+    ((a c (list a b c)))
+    ((b c (list a b c)))))
+
+(define %name
+  (%rel (name country sport)
+    (((person name country sport) name))))
+
+(define %country
+  (%rel (name country sport)
+    (((person name country sport) country))))
+
+(define %sport
+  (%rel (name country sport)
+    (((person name country sport) sport))))
+
+(define %first
+  (%rel (car cdr)
+    (((cons car cdr) car))))
+
+;;With the above as the database, and also loading the file
+;;puzzle.scm containing the puzzle solver, we merely need to
+;;ask (solve-puzzle %games) to get the solution, which is
+;;
+;;((michael is the australian) (richard plays tennis))
+
+(check-equal? (solve-puzzle %games)
+              '((solution= ((michael is the australian) (richard plays tennis)))))

collects/tests/schelog/holland.rkt

@@ -0,0 +1,40 @@
+#lang racket
+
+(require schelog)
+
+;This is a very trivial program.  In Prolog, it would be:
+;
+;    city(amsterdam).
+;    city(brussels).
+;    country(holland).
+;    country(belgium).
+
+(define %city
+  (lambda (x)
+    (%or (%= x 'amsterdam)
+	 (%= x 'brussels))))
+
+(define %country
+  (lambda (x)
+    (%or (%= x 'holland)
+	 (%= x 'belgium))))
+
+;For a more Prolog-style syntax, you can rewrite the same thing,
+;using the `%rel' macro, as the following:
+
+'(define %city
+  (%rel ()
+    (('amsterdam))
+    (('brussels))))
+
+'(define %country
+  (%rel ()
+    (('holland))
+    (('belgium))))
+
+;Typical easy queries:
+;
+; (%which (x) (%city x)) succeeds twice
+; (%which (x) (%country x)) succeeds twice
+; (%which () (%city 'amsterdam)) succeeds
+; (%which () (%country 'amsterdam)) fails

collects/tests/schelog/houses.rkt

@@ -0,0 +1,152 @@
+#lang racket
+
+(require schelog)
+
+;Exercise 14.1 (iv) from Sterling & Shapiro, p. 217-8  
+
+;There are 5 houses, each of a different color and inhabited
+;by a man of a different nationality, with a different pet,
+;drink and cigarette choice.
+;
+;1. The Englishman lives in the red house
+;2. The Spaniard owns the dog
+;3. Coffee is drunk in the green house
+;4. The Ukrainian drinks tea
+;5. The green house is to the immediate right of the ivory house
+;6. The Winston smoker owns snails
+;7. Kools are smoked in the yellow house
+;8. Milk is drunk in the middle house
+;9. The Norwegian lives in the first house on the left
+;10. The Chesterfield smoker lives next to the man with the fox
+;11. Kools are smoked in the house adjacent to the horse's place
+;12. The Lucky Strike smoker drinks orange juice
+;13. The Japanese smokes Parliaments
+;14. The Norwegian lives next to the blue house
+
+;Who owns the zebra?  Who drinks water?
+
+(define house
+  (lambda (hue nation pet drink cigarette)
+    (list 'house hue nation pet drink cigarette)))
+
+(define %hue (%rel (h) (((house h (_) (_) (_) (_)) h))))
+(define %nation (%rel (n) (((house (_) n (_) (_) (_)) n))))
+(define %pet (%rel (p) (((house (_) (_) p (_) (_)) p))))
+(define %drink (%rel (d) (((house (_) (_) (_) d (_)) d))))
+(define %cigarette (%rel (c) (((house (_) (_) (_) (_) c) c))))
+
+(define %adjacent
+  (%rel (a b)
+    ((a b (list a b (_) (_) (_))))
+    ((a b (list (_) a b (_) (_))))
+    ((a b (list (_) (_) a b (_))))
+    ((a b (list (_) (_) (_) a b)))))
+
+(define %middle
+  (%rel (a)
+    ((a (list (_) (_) a (_) (_))))))
+
+(define %houses
+  (%rel (row-of-houses clues queries solution
+	 h1 h2 h3 h4 h5 n1 n2 n3 n4 n5 p1 p2 p3 p4 p5
+	 d1 d2 d3 d4 d5 c1 c2 c3 c4 c5)
+    ((clues queries solution)
+     (%= row-of-houses
+       (list
+	 (house h1 n1 p1 d1 c1)
+	 (house h2 n2 p2 d2 c2)
+	 (house h3 n3 p3 d3 c3)
+	 (house h4 n4 p4 d4 c4)
+	 (house h5 n5 p5 d5 c5)))
+     (%houses-clues row-of-houses clues)
+     (%houses-queries row-of-houses queries solution))))
+
+(define %houses-clues
+  (%rel (row-of-houses abode1 abode2 abode3 abode4 abode5 abode6 abode7
+	 abode8 abode9 abode10 abode11 abode12 abode13 abode14 abode15)
+    ((row-of-houses
+       (list
+	 (%member abode1 row-of-houses)
+	 (%nation abode1 'english)
+	 (%hue abode1 'red)
+
+	 (%member abode2 row-of-houses)
+	 (%nation abode2 'spain)
+	 (%pet abode2 'dog)
+
+	 (%member abode3 row-of-houses)
+	 (%drink abode3 'coffee)
+	 (%hue abode3 'green)
+
+	 (%member abode4 row-of-houses)
+	 (%nation abode4 'ukraine)
+	 (%drink abode4 'tea)
+
+	 (%member abode5 row-of-houses)
+	 (%adjacent abode5 abode3 row-of-houses)
+	 (%hue abode5 'ivory)
+
+	 (%member abode6 row-of-houses)
+	 (%cigarette abode6 'winston)
+	 (%pet abode6 'snail)
+
+	 (%member abode7 row-of-houses)
+	 (%cigarette abode7 'kool)
+	 (%hue abode7 'yellow)
+
+	 (%= (list (_) (_) abode8 (_) (_)) row-of-houses)
+	 (%drink abode8 'milk)
+
+	 (%= (list abode9 (_) (_) (_) (_)) row-of-houses)
+	 (%nation abode9 'norway)
+
+	 (%member abode10 row-of-houses)
+	 (%member abode11 row-of-houses)
+	 (%or (%adjacent abode10 abode11 row-of-houses)
+	   (%adjacent abode11 abode10 row-of-houses))
+	 (%cigarette abode10 'chesterfield)
+	 (%pet abode11 'fox)
+
+	 (%member abode12 row-of-houses)
+	 (%or (%adjacent abode7 abode12 row-of-houses) 
+	   (%adjacent abode12 abode7 row-of-houses))
+	 (%pet abode12 'horse)
+
+	 (%member abode13 row-of-houses)
+	 (%cigarette abode13 'lucky-strike)
+	 (%drink abode13 'oj)
+
+	 (%member abode14 row-of-houses)
+	 (%nation abode14 'japan)
+	 (%cigarette abode14 'parliament)
+
+	 (%member abode15 row-of-houses)
+	 (%or (%adjacent abode9 abode15 row-of-houses) 
+	   (%adjacent abode15 abode9 row-of-houses))
+	 (%hue abode15 'blue))))))
+
+(define %houses-queries
+  (%rel (row-of-houses abode1 abode2 zebra-owner water-drinker)
+    ((row-of-houses
+       (list
+	 (%member abode1 row-of-houses)
+	 (%pet abode1 'zebra)
+	 (%nation abode1 zebra-owner)
+
+	 (%member abode2 row-of-houses)
+	 (%drink abode2 'water)
+	 (%nation abode2 water-drinker))
+
+       (list (list zebra-owner 'owns 'the 'zebra)
+	 (list water-drinker 'drinks 'water))))))
+
+;Load puzzle.scm and type (solve-puzzle %houses)
+
+;Note: This program, as written, requires
+;the occurs check.  Make sure the global
+;*schelog-use-occurs-check?* is set to #t before
+;calling solve-puzzle.  If not, you will get into
+;an infinite loop.
+
+;Note 2: Perhaps there is a way to rewrite the 
+;program so that it doesn't rely on the occurs check.

collects/tests/schelog/mapcol.rkt

@@ -0,0 +1,85 @@
+#lang racket
+
+(require (except-in schelog %member))
+
+;map coloring, example from Sterling & Shapiro, p. 212
+
+;(%member x y) holds if x is in y
+
+;; is this different from the %member provided by schelog? fencing that one out.
+
+(define %member
+  (%rel (X Xs Y Ys)
+    ((X (cons X Xs)))
+    ((X (cons Y Ys)) (%member X Ys))))
+
+;(%members x y) holds if x is a subset of y
+
+(define %members
+  (%rel (X Xs Ys)
+    (((cons X Xs) Ys) (%member X Ys) (%members Xs Ys))
+    (('() Ys))))
+
+;(%select x y z) holds if z is y with one less occurrence of x
+
+(define %select
+  (%rel (X Xs Y Ys Zs)
+    ((X (cons X Xs) Xs))
+    ((X (cons Y Ys) (cons Y Zs))
+     (%select X Ys Zs))))
+
+;region is a structure-builder
+
+(define region
+  (lambda (name color neighbors)
+    (list 'region name color neighbors)))
+
+(define %color-map
+  (%rel (Region Regions Colors)
+    (((cons Region Regions) Colors)
+     (%color-region Region Colors) (%color-map Regions Colors))
+    (('() Colors))))
+
+(define %color-region
+  (%rel (Name Color Neighbors Colors Colors1)
+    (((region Name Color Neighbors) Colors)
+     (%select Color Colors Colors1)
+     (%members Neighbors Colors1))))
+
+(define %test-color
+  (%rel (Name Map Colors)
+    ((Name Map)
+     (%map Name Map)
+     (%colors Colors)
+     (%color-map Map Colors))))
+
+(define %map
+  (%rel (A B C D E F G H I L P S)
+    (('test (list
+	      (region 'a A (list B C D))
+	      (region 'b B (list A C E))
+	      (region 'c C (list A B D E F))
+	      (region 'd D (list A C F))
+	      (region 'e E (list B C F))
+	      (region 'f F (list C D E)))))
+    (('western-europe
+       (list
+	 (region 'portugal P (list E))
+	 (region 'spain E (list F P))
+	 (region 'france F (list E I S B G L))
+	 (region 'belgium B (list F H L G))
+	 (region 'holland H (list B G))
+	 (region 'germany G (list F A S H B L))
+	 (region 'luxembourg L (list F B G))
+	 (region 'italy I (list F A S))
+	 (region 'switzerland S (list F I A G))
+	 (region 'austria A (list I S G)))))))
+
+(define %colors
+  (%rel ()
+    (('(red yellow blue white)))))
+
+;ask (%which (M) (%test-color 'test M)) or
+;ask (%which (M) (%test-color 'western-europe M)) for the
+;respective (non-unique) colorings.
+

collects/tests/schelog/puzzle.rkt

@@ -0,0 +1,47 @@
+#lang racket
+
+(require schelog)
+
+(provide (all-defined-out))
+
+;This is the puzzle solver described in Sterling & Shapiro, p. 214
+
+;As S & S say, it is a "trivial" piece of code
+;that successively solves each clue and query, which are expressed
+;as Prolog goals and are executed with the meta-variable facility.
+
+;The code in "real" Prolog, for comparison, is:
+;
+;  solve_puzzle(Clues, Queries, Solution) 
+;                 :- solve(Clues), solve(Queries).
+;
+;  solve([Clue|Clues]) :- Clue, solve(Clues).
+;  solve([]).
+
+(define %solve-puzzle
+  (%rel (clues queries solution)
+    ((clues queries solution)
+      (%solve clues)
+      (%solve queries))))
+
+(define %solve
+  (%rel (clue clues)
+    (((cons clue clues))
+      clue 
+      (%solve clues))
+    (('()))))
+
+;evaluate (solve-puzzle %puzzle) to get the solution to
+;%puzzle.  Here %puzzle is a relation that is defined to
+;hold for the three arguments clues, queries and solution=,
+;iff they satisfy the constraints imposed by the puzzle.
+;solve-puzzle finds an (the?) instantiation for the solution=
+;variable.
+
+(define solve-puzzle
+  (lambda (%puzzle)
+    (%let (clues queries)
+      (%which (solution=)
+	(%and
+	  (%puzzle clues queries solution=)
+	  (%solve-puzzle clues queries solution=))))))

collects/tests/schelog/run-all.rkt

@@ -0,0 +1,2 @@
+#lang racket
+

collects/tests/schelog/toys.rkt

@@ -0,0 +1,88 @@
+#lang racket
+
+(require (except-in schelog %append))
+
+;A list of trivial programs in Prolog, just so you can get used
+;to schelog syntax.
+
+;(%length l n) holds if length(l) = n
+
+(define %length
+  (%rel (h t n m)
+    (('() 0))
+    (((cons h t) n) (%length t m) (%is n (+ m 1)))))
+
+;(%delete x y z) holds if z is y with all x's removed
+
+(define %delete
+  (%rel (x y z w)
+    ((x '() '()))
+    ((x (cons x w) y) (%delete x w y))
+    ((x (cons z w) (cons z y)) (%not (%= x z)) (%delete x w y))))
+
+;(%remdup x y) holds if y is x without duplicates
+
+(define %remdup
+  (%rel (x y z w)
+    (('() '()))
+    (((cons x y) (cons x z)) (%delete x y w) (%remdup w z))))
+
+;(%count x n) holds if n is the number of elements in x without
+;counting duplicates
+
+'(define %count
+  (%rel (x n y)
+    ((x n) (%remdup x y) (%length y n))))
+
+;same thing
+
+(define %count
+  (letrec ((countaux
+	     (%rel (m n m+1 x y z)
+	       (('() m m))
+	       (((cons x y) m n)
+		(%delete x y z) (%is m+1 (+ m 1)) (countaux z m+1 n)))))
+    (%rel (x n)
+      ((x n) (countaux x 0 n)))))
+
+;(%append x y z) holds if z is the concatenation of x and y
+
+(define %append
+  (%rel (x y z w)
+    (('() x x))
+    (((cons x y) z (cons x w)) (%append y z w))))
+
+;(%reverse x y) holds if the y is the reversal of x
+
+'(define %reverse
+  (%rel (x y z yy)
+    (('() '()))
+    (((cons x y) z) (%reverse y yy) (%append yy (list x) z))))
+
+;same thing, but tailcall optimizing
+
+(define %reverse
+  (letrec ((revaux
+	     (%rel (x y z w)
+	       (('() y y))
+	       (((cons x y) z w) (revaux y (cons x z) w)))))
+    (%rel (x y)
+      ((x y) (revaux x '() y)))))
+
+;(%fact n m) holds if m = n!
+
+'(define %fact
+  (%rel (n n! n-1 n-1!)
+    ((0 1))
+    ((n n!) (%is n-1 (- n 1)) (%fact n-1 n-1!) (%is n! (* n n-1!)))))
+
+;same thing, but tailcall optimizing
+
+(define %fact
+  (letrec ((factaux
+	     (%rel (n! m x m-1 xx)
+	       ((0 n! n!))
+	       ((m x n!) (%is m-1 (- m 1)) (%is xx (* x m))
+		(factaux m-1 xx n!)))))
+    (%rel (n n!)
+      ((n n!) (factaux n 1 n!)))))