├── COPYING ├── README.org ├── minikanren.scm ├── minikanren ├── mk.scm ├── mkextraforms.scm └── mkprelude.scm ├── mktests.scm └── pkg-list.scm /COPYING: -------------------------------------------------------------------------------- 1 | Copyright (c) 2005 Daniel P. Friedman, William E. Byrd and Oleg Kiselyov 2 | Copyright (c) 2012 Ian Price 3 | 4 | Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: 5 | 6 | The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. 7 | 8 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. 9 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | -*- mode : org -*- 2 | * MiniKanren - A declarative logic programming system 3 | 4 | ** What is it? 5 | MiniKanren is a relational programming extension to the Scheme 6 | programming Language, written as a smaller version of [[http://kanren.sourceforge.net/][Kanren]] suitable 7 | for pedagogical purposes. It is featured in the book, [[https://mitpress.mit.edu/books/reasoned-schemer][The Reasoned 8 | Schemer]], written by Dan Friedman, William Byrd, and Oleg Kiselyov. 9 | 10 | ** How do I install it 11 | Place the directory minikanren and the file minikanren.scm somewhere 12 | on your scheme implementations path. 13 | 14 | A pkg-list.scm file is also provided for use with dorodango/guildhall 15 | 16 | ** What is its license? 17 | According to its website, and the [[https://github.com/webyrd/miniKanren][MiniKanren repository of William 18 | Byrd]] , Kanren, and therefore MiniKanren, is released under the MIT 19 | License. See COPYING for details. 20 | 21 | ** How does this version differ from the original repository? 22 | This version has been modified by me (Ian Price), for use in r6rs 23 | scheme systems. 24 | 25 | I have also taken the decision to add an additional file, 26 | minikanren.scm, which provides a subset of the original files which I 27 | feel are most useful to be able to get with a single import. All 28 | bindings from the original files are still available, but you will 29 | need to them import with 30 | 31 | #+begin_src scheme 32 | (import (minikanren mk) 33 | (minikanren mkextraforms) 34 | (minikanren mkprelude)) 35 | #+end_src 36 | 37 | rather than with 38 | 39 | #+begin_src scheme 40 | (import (minikanren)) 41 | #+end_src 42 | 43 | If you would like to challenge this, feel free to drop me an email, or 44 | a pull request. 45 | -------------------------------------------------------------------------------- /minikanren.scm: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (library (minikanren) 3 | (export run 4 | succeed 5 | fail 6 | == 7 | ==-check 8 | fresh 9 | conde 10 | all 11 | alli 12 | condi 13 | conda 14 | condu 15 | ife 16 | ifi 17 | ifa 18 | ifu 19 | run* 20 | lambda-limited 21 | 22 | caro 23 | cdro 24 | conso 25 | nullo 26 | eqo 27 | eq-caro 28 | pairo 29 | listo 30 | membero 31 | rembero 32 | appendo 33 | anyo 34 | nevero 35 | alwayso 36 | 37 | build-num 38 | poso 39 | >1o 40 | +o 41 | -o 42 | *o 43 | =lo 44 | 81 | (lambda (a) 82 | (walk (rhs a) s))) 83 | (else v))) 84 | (else v)))) 85 | 86 | (define ext-s 87 | (lambda (x v s) 88 | (cons `(,x . ,v) s))) 89 | 90 | (define unify 91 | (lambda (v w s) 92 | (let ((v (walk v s)) 93 | (w (walk w s))) 94 | (cond 95 | ((eq? v w) s) 96 | ((var? v) (ext-s v w s)) 97 | ((var? w) (ext-s w v s)) 98 | ((and (pair? v) (pair? w)) 99 | (cond 100 | ((unify (car v) (car w) s) => 101 | (lambda (s) 102 | (unify (cdr v) (cdr w) s))) 103 | (else #f))) 104 | ((equal? v w) s) 105 | (else #f))))) 106 | 107 | (define ext-s-check 108 | (lambda (x v s) 109 | (cond 110 | ((occurs-check x v s) #f) 111 | (else (ext-s x v s))))) 112 | 113 | (define occurs-check 114 | (lambda (x v s) 115 | (let ((v (walk v s))) 116 | (cond 117 | ((var? v) (eq? v x)) 118 | ((pair? v) 119 | (or 120 | (occurs-check x (car v) s) 121 | (occurs-check x (cdr v) s))) 122 | (else #f))))) 123 | 124 | (define unify-check 125 | (lambda (v w s) 126 | (let ((v (walk v s)) 127 | (w (walk w s))) 128 | (cond 129 | ((eq? v w) s) 130 | ((var? v) (ext-s-check v w s)) 131 | ((var? w) (ext-s-check w v s)) 132 | ((and (pair? v) (pair? w)) 133 | (cond 134 | ((unify-check (car v) (car w) s) => 135 | (lambda (s) 136 | (unify-check (cdr v) (cdr w) s))) 137 | (else #f))) 138 | ((equal? v w) s) 139 | (else #f))))) 140 | 141 | (define walk* 142 | (lambda (v s) 143 | (let ((v (walk v s))) 144 | (cond 145 | ((var? v) v) 146 | ((pair? v) 147 | (cons 148 | (walk* (car v) s) 149 | (walk* (cdr v) s))) 150 | (else v))))) 151 | 152 | (define reify-s 153 | (lambda (v s) 154 | (let ((v (walk v s))) 155 | (cond 156 | ((var? v) (ext-s v (reify-name (size-s s)) s)) 157 | ((pair? v) (reify-s (cdr v) (reify-s (car v) s))) 158 | (else s))))) 159 | 160 | (define reify-name 161 | (lambda (n) 162 | (string->symbol 163 | (string-append "_" "." (number->string n))))) 164 | 165 | (define reify 166 | (lambda (v) 167 | (walk* v (reify-s v empty-s)))) 168 | 169 | (define-syntax run 170 | (syntax-rules () 171 | ((_ n^ (x) g ...) 172 | (let ((n n^) (x (var 'x))) 173 | (if (or (not n) (> n 0)) 174 | (map-inf n 175 | (lambda (s) 176 | (reify (walk* x s))) 177 | ((all g ...) empty-s)) 178 | '()))))) 179 | 180 | (define-syntax case-inf 181 | (syntax-rules () 182 | ((_ e on-zero ((a^) on-one) ((a f) on-choice)) 183 | (let ((a-inf e)) 184 | (cond 185 | ((not a-inf) on-zero) 186 | ((not (and 187 | (pair? a-inf) 188 | (procedure? (cdr a-inf)))) 189 | (let ((a^ a-inf)) 190 | on-one)) 191 | (else (let ((a (car a-inf)) 192 | (f (cdr a-inf))) 193 | on-choice))))))) 194 | 195 | (define-syntax mzero 196 | (syntax-rules () 197 | ((_) #f))) 198 | 199 | (define-syntax unit 200 | (syntax-rules () 201 | ((_ a) a))) 202 | 203 | (define-syntax choice 204 | (syntax-rules () 205 | ((_ a f) (cons a f)))) 206 | 207 | (define map-inf 208 | (lambda (n p a-inf) 209 | (case-inf a-inf 210 | '() 211 | ((a) 212 | (cons (p a) '())) 213 | ((a f) 214 | (cons (p a) 215 | (cond 216 | ((not n) (map-inf n p (f))) 217 | ((> n 1) (map-inf (- n 1) p (f))) 218 | (else '()))))))) 219 | 220 | (define succeed (lambdag@ (s) (unit s))) 221 | (define fail (lambdag@ (s) (mzero))) 222 | 223 | (define == 224 | (lambda (v w) 225 | (lambdag@ (s) 226 | (cond 227 | ((unify v w s) => succeed) 228 | (else (fail s)))))) 229 | 230 | (define ==-check 231 | (lambda (v w) 232 | (lambdag@ (s) 233 | (cond 234 | ((unify-check v w s) => succeed) 235 | (else (fail s)))))) 236 | 237 | (define-syntax fresh 238 | (syntax-rules () 239 | ((_ (x ...) g ...) 240 | (lambdag@ (s) 241 | (let ((x (var 'x)) ...) 242 | ((all g ...) s)))))) 243 | 244 | (define-syntax conde 245 | (syntax-rules () 246 | ((_ c ...) (cond-aux ife c ...)))) 247 | 248 | (define-syntax all 249 | (syntax-rules () 250 | ((_ g ...) (all-aux bind g ...)))) 251 | 252 | (define-syntax alli 253 | (syntax-rules () 254 | ((_ g ...) (all-aux bindi g ...)))) 255 | 256 | (define-syntax condi 257 | (syntax-rules () 258 | ((_ c ...) (cond-aux ifi c ...)))) 259 | 260 | (define-syntax conda 261 | (syntax-rules () 262 | ((_ c ...) (cond-aux ifa c ...)))) 263 | 264 | (define-syntax condu 265 | (syntax-rules () 266 | ((_ c ...) (cond-aux ifu c ...)))) 267 | 268 | (define mplus 269 | (lambda (a-inf f) 270 | (case-inf a-inf 271 | (f) 272 | ((a) (choice a f)) 273 | ((a f0) (choice a 274 | (lambdaf@ () (mplus (f0) f))))))) 275 | 276 | (define bind 277 | (lambda (a-inf g) 278 | (case-inf a-inf 279 | (mzero) 280 | ((a) (g a)) 281 | ((a f) (mplus (g a) 282 | (lambdaf@ () (bind (f) g))))))) 283 | 284 | (define mplusi 285 | (lambda (a-inf f) 286 | (case-inf a-inf 287 | (f) 288 | ((a) (choice a f)) 289 | ((a f0) (choice a 290 | (lambdaf@ () (mplusi (f) f0))))))) 291 | 292 | (define bindi 293 | (lambda (a-inf g) 294 | (case-inf a-inf 295 | (mzero) 296 | ((a) (g a)) 297 | ((a f) (mplusi (g a) 298 | (lambdaf@ () (bindi (f) g))))))) 299 | 300 | (define-syntax all-aux 301 | (syntax-rules () 302 | ((_ bnd) succeed) 303 | ((_ bnd g) g) 304 | ((_ bnd g0 g ...) 305 | (let ((g^ g0)) 306 | (lambdag@ (s) 307 | (bnd (g^ s) 308 | (lambdag@ (s) ((all-aux bnd g ...) s)))))))) 309 | 310 | (define-syntax cond-aux 311 | (syntax-rules (else) 312 | ((_ ifer) fail) 313 | ((_ ifer (else g ...)) (all g ...)) 314 | ((_ ifer (g ...)) (all g ...)) 315 | ((_ ifer (g0 g ...) c ...) 316 | (ifer g0 317 | (all g ...) 318 | (cond-aux ifer c ...))))) 319 | 320 | (define-syntax ife 321 | (syntax-rules () 322 | ((_ g0 g1 g2) 323 | (lambdag@ (s) 324 | (mplus ((all g0 g1) s) (lambdaf@ () (g2 s))))))) 325 | 326 | (define-syntax ifi 327 | (syntax-rules () 328 | ((_ g0 g1 g2) 329 | (lambdag@ (s) 330 | (mplusi ((all g0 g1) s) (lambdaf@ () (g2 s))))))) 331 | 332 | (define-syntax ifa 333 | (syntax-rules () 334 | ((_ g0 g1 g2) 335 | (lambdag@ (s) 336 | (let ((s-inf (g0 s))) 337 | (case-inf s-inf 338 | (g2 s) 339 | ((s) (g1 s)) 340 | ((s f) (bind s-inf g1)))))))) 341 | 342 | (define-syntax ifu 343 | (syntax-rules () 344 | ((_ g0 g1 g2) 345 | (lambdag@ (s) 346 | (let ((s-inf (g0 s))) 347 | (case-inf s-inf 348 | (g2 s) 349 | ((s) (g1 s)) 350 | ((s f) (g1 s)))))))) 351 | 352 | ) 353 | -------------------------------------------------------------------------------- /minikanren/mkextraforms.scm: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (library (minikanren mkextraforms) 3 | (export run* 4 | lambda-limited 5 | ll 6 | project 7 | ) 8 | (import (rnrs) 9 | (minikanren mk)) 10 | ;;; Code that accompanies ``The Reasoned Schemer'' 11 | ;;; Daniel P. Friedman, William E. Byrd and Oleg Kiselyov 12 | ;;; MIT Press, Cambridge, MA, 2005 13 | ;;; 14 | ;;; Extra forms appearing in the framenotes of the book. 15 | ;;; 16 | ;;; run* is a convenient macro (see frame 10 on page 4 of chapter 1) 17 | ;;; (run* (q) ...) is identical to (run #f (q) ...) 18 | ;;; See frame 40 on page 68 of chapter 5 for a description of 'lambda-limited'. 19 | ;;; See frame 47 on page 138 of chapter 9 for a description of 'project'. 20 | ;;; 21 | ;;; This file was generated by writeminikanren.pl 22 | ;;; Generated at 2005-08-12 11:27:16 23 | 24 | (define-syntax run* 25 | (syntax-rules () 26 | ((_ (x) g ...) (run #f (x) g ...)))) 27 | 28 | (define-syntax lambda-limited 29 | (syntax-rules () 30 | ((_ n formals g) 31 | (let ((x (var 'x))) 32 | (lambda formals 33 | (ll n x g)))))) 34 | 35 | (define ll 36 | (lambda (n x g) 37 | (lambdag@ (s) 38 | (let ((v (walk x s))) 39 | (cond 40 | ((var? v) (g (ext-s x 1 s))) 41 | ((< v n) (g (ext-s x (+ v 1) s))) 42 | (else (fail s))))))) 43 | 44 | (define-syntax project 45 | (syntax-rules () 46 | ((_ (x ...) g ...) 47 | (lambdag@ (s) 48 | (let ((x (walk* x s)) ...) 49 | ((all g ...) s)))))) 50 | ) 51 | -------------------------------------------------------------------------------- /minikanren/mkprelude.scm: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | (library (minikanren mkprelude) 3 | (export caro 4 | cdro 5 | conso 6 | nullo 7 | eqo 8 | eq-caro 9 | pairo 10 | listo 11 | membero 12 | rembero 13 | appendo 14 | anyo 15 | nevero 16 | alwayso 17 | 18 | build-num 19 | full-addero 20 | poso 21 | >1o 22 | gen-addero 23 | +o 24 | -o 25 | *o 26 | odd-*o 27 | bound-*o 28 | =lo 29 | 1o 169 | (lambda (n) 170 | (fresh (a ad dd) 171 | (== `(,a ,ad . ,dd) n)))) 172 | 173 | (define addero 174 | (lambda (d n m r) 175 | (condi 176 | ((== 0 d) (== '() m) (== n r)) 177 | ((== 0 d) (== '() n) (== m r) 178 | (poso m)) 179 | ((== 1 d) (== '() m) 180 | (addero 0 n '(1) r)) 181 | ((== 1 d) (== '() n) (poso m) 182 | (addero 0 '(1) m r)) 183 | ((== '(1) n) (== '(1) m) 184 | (fresh (a c) 185 | (== `(,a ,c) r) 186 | (full-addero d 1 1 a c))) 187 | ((== '(1) n) (gen-addero d n m r)) 188 | ((== '(1) m) (>1o n) (>1o r) 189 | (addero d '(1) n r)) 190 | ((>1o n) (gen-addero d n m r)) 191 | (else fail)))) 192 | 193 | (define gen-addero 194 | (lambda (d n m r) 195 | (fresh (a b c e x y z) 196 | (== `(,a . ,x) n) 197 | (== `(,b . ,y) m) (poso y) 198 | (== `(,c . ,z) r) (poso z) 199 | (alli 200 | (full-addero d a b c e) 201 | (addero e x y z))))) 202 | 203 | (define +o 204 | (lambda (n m k) 205 | (addero 0 n m k))) 206 | 207 | (define -o 208 | (lambda (n m k) 209 | (+o m k n))) 210 | 211 | (define *o 212 | (lambda (n m p) 213 | (condi 214 | ((== '() n) (== '() p)) 215 | ((poso n) (== '() m) (== '() p)) 216 | ((== '(1) n) (poso m) (== m p)) 217 | ((>1o n) (== '(1) m) (== n p)) 218 | ((fresh (x z) 219 | (== `(0 . ,x) n) (poso x) 220 | (== `(0 . ,z) p) (poso z) 221 | (>1o m) 222 | (*o x m z))) 223 | ((fresh (x y) 224 | (== `(1 . ,x) n) (poso x) 225 | (== `(0 . ,y) m) (poso y) 226 | (*o m n p))) 227 | ((fresh (x y) 228 | (== `(1 . ,x) n) (poso x) 229 | (== `(1 . ,y) m) (poso y) 230 | (odd-*o x n m p))) 231 | (else fail)))) 232 | 233 | (define odd-*o 234 | (lambda (x n m p) 235 | (fresh (q) 236 | (bound-*o q p n m) 237 | (*o x m q) 238 | (+o `(0 . ,q) m p)))) 239 | 240 | (define bound-*o 241 | (lambda (q p n m) 242 | (conde 243 | ((nullo q) (pairo p)) 244 | (else 245 | (fresh (x y z) 246 | (cdro q x) 247 | (cdro p y) 248 | (condi 249 | ((nullo n) 250 | (cdro m z) 251 | (bound-*o x y z '())) 252 | (else 253 | (cdro n z) 254 | (bound-*o x y z m)))))))) 255 | 256 | (define =lo 257 | (lambda (n m) 258 | (conde 259 | ((== '() n) (== '() m)) 260 | ((== '(1) n) (== '(1) m)) 261 | (else 262 | (fresh (a x b y) 263 | (== `(,a . ,x) n) (poso x) 264 | (== `(,b . ,y) m) (poso y) 265 | (=lo x y)))))) 266 | 267 | (define 1o m)) 272 | (else 273 | (fresh (a x b y) 274 | (== `(,a . ,x) n) (poso x) 275 | (== `(,b . ,y) m) (poso y) 276 | (1o b) (=lo n b) (+o r b n)) 369 | ((== '(1) b) (poso q) (+o r '(1) n)) 370 | ((== '() b) (poso q) (== r n)) 371 | ((== '(0 1) b) 372 | (fresh (a ad dd) 373 | (poso dd) 374 | (== `(,a ,ad . ,dd) n) 375 | (exp2 n '() q) 376 | (fresh (s) 377 | (splito n dd r s)))) 378 | ((fresh (a ad add ddd) 379 | (conde 380 | ((== '(1 1) b)) 381 | (else (== `(,a ,ad ,add . ,ddd) b)))) 382 | (1o n) (== '(1) q) 419 | (fresh (s) 420 | (splito n b s '(1)))) 421 | ((fresh (q1 b2) 422 | (alli 423 | (== `(0 . ,q1) q) 424 | (poso q1) 425 | (1o q) 444 | (fresh (q1 nq1) 445 | (+o q1 '(1) q) 446 | (repeated-mul n q1 nq1) 447 | (*o nq1 n nq))) 448 | (else fail)))) 449 | 450 | (define expo 451 | (lambda (b q n) 452 | (logo n b q '()))) 453 | 454 | ;;; 'trace-vars' can be used to print the values of selected variables 455 | ;;; in the substitution. 456 | (define-syntax trace-vars 457 | (syntax-rules () 458 | ((_ title x ...) 459 | (lambdag@ (s) 460 | (begin 461 | (display title) 462 | (newline) 463 | (for-each (lambda (x_ t) 464 | (display x_) 465 | (display " = ") 466 | (write t) 467 | (newline)) 468 | `(x ...) (reify (walk* `(,x ...) s))) 469 | (unit s)))))) 470 | 471 | ;;; (run* (q) 472 | ;;; (fresh (r) 473 | ;;; (== 3 q) 474 | ;;; (trace-vars "What it is!" q r))) 475 | ;;; 476 | ;;; What it is! 477 | ;;; q = 3 478 | ;;; r = _.0 479 | ;;; (3) 480 | ) 481 | -------------------------------------------------------------------------------- /mktests.scm: -------------------------------------------------------------------------------- 1 | #!r6rs 2 | ;;; Code that accompanies ``The Reasoned Schemer'' 3 | ;;; Daniel P. Friedman, William E. Byrd and Oleg Kiselyov 4 | ;;; MIT Press, Cambridge, MA, 2005 5 | ;;; 6 | ;;; All the examples used in the book 7 | 8 | ;;; This file was generated by writeminikanren.pl 9 | ;;; Generated at 2005-08-12 11:27:16 10 | 11 | (import (rnrs) 12 | (minikanren mk) 13 | (minikanren mkextraforms)) 14 | 15 | (define nil '()) 16 | 17 | (define-syntax test-check 18 | (syntax-rules () 19 | ((_ title tested-expression expected-result) 20 | (begin 21 | (cout "Testing " title nl) 22 | (let* ((expected expected-result) 23 | (produced tested-expression)) 24 | (or (equal? expected produced) 25 | (errorf 'test-check 26 | "Failed: ~a~%Expected: ~a~%Computed: ~a~%" 27 | 'tested-expression expected produced))))))) 28 | 29 | (define nl (string #\newline)) 30 | 31 | (define (cout . args) 32 | (for-each (lambda (x) 33 | (if (procedure? x) (x) (display x))) 34 | args)) 35 | 36 | (define errorf 37 | (lambda (tag . args) 38 | (display "Failed: ") (display tag) (newline) 39 | (for-each display args) 40 | (error 'WiljaCodeTester "That's all, folks!"))) 41 | 42 | (define-syntax test-divergence 43 | (syntax-rules () 44 | ((_ title tested-expression) 45 | (let ((max-ticks 10000000)) 46 | (cout "Testing " title " (engine with " max-ticks " ticks fuel)" nl) 47 | ((make-engine (lambda () tested-expression)) 48 | max-ticks 49 | (lambda (t v) 50 | (errorf title 51 | "infinite loop returned " v " after " (- max-ticks t) " ticks")) 52 | (lambda (e^) (void))))))) 53 | 54 | ;;; Comment out this definition to test divergent code (Chez Scheme only) 55 | (define-syntax test-divergence 56 | (syntax-rules () 57 | ((_ title tested-expression) (cout "Ignoring divergent test " title nl)))) 58 | 59 | (test-check "1.10" 60 | (run* (q) 61 | fail) 62 | `()) 63 | 64 | (test-check "1.11" 65 | (run* (q) 66 | (== #t q)) 67 | `(#t)) 68 | 69 | (test-check "1.12" 70 | (run* (q) 71 | fail 72 | (== #t q)) 73 | `()) 74 | 75 | (define g fail) 76 | 77 | (test-check "1.13" 78 | (run* (q) 79 | succeed 80 | (== #t q)) 81 | (list #t)) 82 | 83 | (test-check "1.14" 84 | (run* (q) 85 | succeed 86 | (== #t q)) 87 | `(#t)) 88 | 89 | (test-check "1.15" 90 | (run* (r) 91 | succeed 92 | (== 'corn r)) 93 | (list 'corn)) 94 | 95 | (test-check "1.16" 96 | (run* (r) 97 | succeed 98 | (== 'corn r)) 99 | `(corn)) 100 | 101 | (test-check "1.17" 102 | (run* (r) 103 | fail 104 | (== 'corn r)) 105 | `()) 106 | 107 | (test-check "1.18" 108 | (run* (q) 109 | succeed 110 | (== #f q)) 111 | `(#f)) 112 | 113 | (test-check "1.22" 114 | (run* (x) 115 | (let ((x #f)) 116 | (== #t x))) 117 | '()) 118 | 119 | (test-check "1.23" 120 | (run* (q) 121 | (fresh (x) 122 | (== #t x) 123 | (== #t q))) 124 | (list #t)) 125 | 126 | (test-check "1.26" 127 | (run* (q) 128 | (fresh (x) 129 | (== x #t) 130 | (== #t q))) 131 | (list #t)) 132 | 133 | (test-check "1.27" 134 | (run* (q) 135 | (fresh (x) 136 | (== x #t) 137 | (== q #t))) 138 | (list #t)) 139 | 140 | (test-check "1.28" 141 | (run* (x) 142 | succeed) 143 | (list `_.0)) 144 | 145 | (test-check "1.29" 146 | (run* (x) 147 | (let ((x #f)) 148 | (fresh (x) 149 | (== #t x)))) 150 | `(_.0)) 151 | 152 | (test-check "1.30" 153 | (run* (r) 154 | (fresh (x y) 155 | (== (cons x (cons y '())) r))) 156 | (list `(_.0 _.1))) 157 | 158 | (test-check "1.31" 159 | (run* (s) 160 | (fresh (t u) 161 | (== (cons t (cons u '())) s))) 162 | (list `(_.0 _.1))) 163 | 164 | (test-check "1.32" 165 | (run* (r) 166 | (fresh (x) 167 | (let ((y x)) 168 | (fresh (x) 169 | (== (cons y (cons x (cons y '()))) r))))) 170 | (list `(_.0 _.1 _.0))) 171 | 172 | (test-check "1.33" 173 | (run* (r) 174 | (fresh (x) 175 | (let ((y x)) 176 | (fresh (x) 177 | (== (cons x (cons y (cons x '()))) r))))) 178 | (list `(_.0 _.1 _.0))) 179 | 180 | (test-check "1.34" 181 | (run* (q) 182 | (== #f q) 183 | (== #t q)) 184 | `()) 185 | 186 | (test-check "1.35" 187 | (run* (q) 188 | (== #f q) 189 | (== #f q)) 190 | '(#f)) 191 | 192 | (test-check "1.36" 193 | (run* (q) 194 | (let ((x q)) 195 | (== #t x))) 196 | (list #t)) 197 | 198 | (test-check "1.37" 199 | (run* (r) 200 | (fresh (x) 201 | (== x r))) 202 | (list `_.0)) 203 | 204 | (test-check "1.38" 205 | (run* (q) 206 | (fresh (x) 207 | (== #t x) 208 | (== x q))) 209 | (list #t)) 210 | 211 | (test-check "1.39" 212 | (run* (q) 213 | (fresh (x) 214 | (== x q) 215 | (== #t x))) 216 | (list #t)) 217 | 218 | (test-check "1.40.1" 219 | (run* (q) 220 | (fresh (x) 221 | (== (eq? x q) q))) 222 | (list #f)) 223 | 224 | (test-check "1.40.2" 225 | (run* (q) 226 | (let ((x q)) 227 | (fresh (q) 228 | (== (eq? x q) x)))) 229 | (list #f)) 230 | 231 | (test-check "1.41" 232 | (cond 233 | (#f #t) 234 | (else #f)) 235 | #f) 236 | 237 | (test-check "1.43" 238 | (cond 239 | (#f succeed) 240 | (else fail)) 241 | fail) 242 | 243 | (test-check "1.44" 244 | (run* (q) 245 | (conde 246 | (fail succeed) 247 | (else fail))) 248 | '()) 249 | 250 | (test-check "1.45" 251 | (not (null? (run* (q) 252 | (conde 253 | (fail fail) 254 | (else succeed))))) 255 | #t) 256 | 257 | (test-check "1.46" 258 | (not (null? (run* (q) 259 | (conde 260 | (succeed succeed) 261 | (else fail))))) 262 | #t) 263 | 264 | 265 | (test-check "1.47" 266 | (run* (x) 267 | (conde 268 | ((== 'olive x) succeed) 269 | ((== 'oil x) succeed) 270 | (else fail))) 271 | `(olive oil)) 272 | 273 | (test-check "1.49" 274 | (run 1 (x) 275 | (conde 276 | ((== 'olive x) succeed) 277 | ((== 'oil x) succeed) 278 | (else fail))) 279 | `(olive)) 280 | 281 | (test-check "1.50.1" 282 | (run* (x) 283 | (conde 284 | ((== 'virgin x) fail) 285 | ((== 'olive x) succeed) 286 | (succeed succeed) 287 | ((== 'oil x) succeed) 288 | (else fail))) 289 | `(olive _.0 oil)) 290 | 291 | (test-check "1.50.2" 292 | (run* (x) 293 | (conde 294 | ((== 'olive x) succeed) 295 | (succeed succeed) 296 | ((== 'oil x) succeed) 297 | (else fail))) 298 | `(olive _.0 oil)) 299 | 300 | (test-check "1.52" 301 | (run 2 (x) 302 | (conde 303 | ((== 'extra x) succeed) 304 | ((== 'virgin x) fail) 305 | ((== 'olive x) succeed) 306 | ((== 'oil x) succeed) 307 | (else fail))) 308 | `(extra olive)) 309 | 310 | (test-check "1.53" 311 | (run* (r) 312 | (fresh (x y) 313 | (== 'split x) 314 | (== 'pea y) 315 | (== (cons x (cons y '())) r))) 316 | (list `(split pea))) 317 | 318 | (test-check "1.54" 319 | (run* (r) 320 | (fresh (x y) 321 | (conde 322 | ((== 'split x) (== 'pea y)) 323 | ((== 'navy x) (== 'bean y)) 324 | (else fail)) 325 | (== (cons x (cons y '())) r))) 326 | `((split pea) (navy bean))) 327 | 328 | (test-check "1.55" 329 | (run* (r) 330 | (fresh (x y) 331 | (conde 332 | ((== 'split x) (== 'pea y)) 333 | ((== 'navy x) (== 'bean y)) 334 | (else fail)) 335 | (== (cons x (cons y (cons 'soup '()))) r))) 336 | `((split pea soup) (navy bean soup))) 337 | 338 | ; 1.56 339 | (define teacupo 340 | (lambda (x) 341 | (conde 342 | ((== 'tea x) succeed) 343 | ((== 'cup x) succeed) 344 | (else fail)))) 345 | 346 | (test-check "1.56" 347 | (run* (x) 348 | (teacupo x)) 349 | `(tea cup)) 350 | 351 | (test-check "1.57" 352 | (run* (r) 353 | (fresh (x y) 354 | (conde 355 | ((teacupo x) (== #t y) succeed) 356 | ((== #f x) (== #t y)) 357 | (else fail)) 358 | (== (cons x (cons y '())) r))) 359 | `((tea #t) (cup #t) (#f #t))) 360 | 361 | (test-check "1.58" 362 | (run* (r) 363 | (fresh (x y z) 364 | (conde 365 | ((== y x) (fresh (x) (== z x))) 366 | ((fresh (x) (== y x)) (== z x)) 367 | (else fail)) 368 | (== (cons y (cons z '())) r))) 369 | `((_.0 _.1) (_.0 _.1))) 370 | 371 | (test-check "1.59" 372 | (run* (r) 373 | (fresh (x y z) 374 | (conde 375 | ((== y x) (fresh (x) (== z x))) 376 | ((fresh (x) (== y x)) (== z x)) 377 | (else fail)) 378 | (== #f x) 379 | (== (cons y (cons z '())) r))) 380 | `((#f _.0) (_.0 #f))) 381 | 382 | (test-check "1.60" 383 | (run* (q) 384 | (let ((a (== #t q)) 385 | (b (== #f q))) 386 | b)) 387 | '(#f)) 388 | 389 | (test-check "1.61" 390 | (run* (q) 391 | (let ((a (== #t q)) 392 | (b (fresh (x) 393 | (== x q) 394 | (== #f x))) 395 | (c (conde 396 | ((== #t q) succeed) 397 | (else (== #f q))))) 398 | b)) 399 | '(#f)) 400 | 401 | (test-check "2.1" 402 | (let ((x (lambda (a) a)) 403 | (y 'c)) 404 | (x y)) 405 | 'c) 406 | 407 | (test-check "2.2" 408 | (run* (r) 409 | (fresh (y x) 410 | (== `(,x ,y) r))) 411 | (list `(_.0 _.1))) 412 | 413 | (test-check "2.3" 414 | (run* (r) 415 | (fresh (v w) 416 | (== (let ((x v) (y w)) `(,x ,y)) r))) 417 | `((_.0 _.1))) 418 | 419 | (test-check "2.4" 420 | (car `(grape raisin pear)) 421 | `grape) 422 | 423 | (test-check "2.5" 424 | (car `(a c o r n)) 425 | 'a) 426 | 427 | ; 2.9 428 | (define caro 429 | (lambda (p a) 430 | (fresh (d) 431 | (== (cons a d) p)))) 432 | 433 | (test-check "2.6" 434 | (run* (r) 435 | (caro `(a c o r n) r)) 436 | (list 'a)) 437 | 438 | (test-check "2.7" 439 | (run* (q) 440 | (caro `(a c o r n) 'a) 441 | (== #t q)) 442 | (list #t)) 443 | 444 | (test-check "2.8" 445 | (run* (r) 446 | (fresh (x y) 447 | (caro `(,r ,y) x) 448 | (== 'pear x))) 449 | (list 'pear)) 450 | 451 | (test-check "2.10" 452 | (cons 453 | (car `(grape raisin pear)) 454 | (car `((a) (b) (c)))) 455 | `(grape a)) 456 | 457 | (test-check "2.11" 458 | (run* (r) 459 | (fresh (x y) 460 | (caro `(grape raisin pear) x) 461 | (caro `((a) (b) (c)) y) 462 | (== (cons x y) r))) 463 | (list `(grape a))) 464 | 465 | (test-check "2.13" 466 | (cdr `(grape raisin pear)) 467 | `(raisin pear)) 468 | 469 | (test-check "2.14" 470 | (car (cdr `(a c o r n))) 471 | 'c) 472 | 473 | ; 2.16 474 | (define cdro 475 | (lambda (p d) 476 | (fresh (a) 477 | (== (cons a d) p)))) 478 | 479 | (test-check "2.15" 480 | (run* (r) 481 | (fresh (v) 482 | (cdro `(a c o r n) v) 483 | (caro v r))) 484 | (list 'c)) 485 | 486 | (test-check "2.17" 487 | (cons 488 | (cdr `(grape raisin pear)) 489 | (car `((a) (b) (c)))) 490 | `((raisin pear) a)) 491 | 492 | (test-check "2.18" 493 | (run* (r) 494 | (fresh (x y) 495 | (cdro `(grape raisin pear) x) 496 | (caro `((a) (b) (c)) y) 497 | (== (cons x y) r))) 498 | (list `((raisin pear) a))) 499 | 500 | (test-check "2.19.1" 501 | (run* (q) 502 | (cdro '(a c o r n) '(c o r n)) 503 | (== #t q)) 504 | (list #t)) 505 | 506 | (test-check "2.19.2" 507 | `(c o r n) 508 | (cdr '(a c o r n))) 509 | 510 | (test-check "2.20.1" 511 | (run* (x) 512 | (cdro '(c o r n) `(,x r n))) 513 | (list 'o)) 514 | 515 | (test-check "2.20.2" 516 | `(o r n) 517 | (cdr `(c o r n))) 518 | 519 | (test-check "2.21" 520 | (run* (l) 521 | (fresh (x) 522 | (cdro l '(c o r n)) 523 | (caro l x) 524 | (== 'a x))) 525 | (list `(a c o r n))) 526 | 527 | ; 2.28 528 | (define conso 529 | (lambda (a d p) 530 | (== (cons a d) p))) 531 | 532 | (test-check "2.22" 533 | (run* (l) 534 | (conso '(a b c) '(d e) l)) 535 | (list `((a b c) d e))) 536 | 537 | (test-check "2.23.1" 538 | (run* (x) 539 | (conso x '(a b c) '(d a b c))) 540 | (list 'd)) 541 | 542 | (test-check "2.23.2" 543 | (cons 'd '(a b c)) 544 | `(d a b c)) 545 | 546 | (test-check "2.24" 547 | (run* (r) 548 | (fresh (x y z) 549 | (== `(e a d ,x) r) 550 | (conso y `(a ,z c) r))) 551 | (list `(e a d c))) 552 | 553 | (test-check "2.25.1" 554 | (run* (x) 555 | (conso x `(a ,x c) `(d a ,x c))) 556 | (list 'd)) 557 | 558 | (define x 'd) 559 | 560 | (test-check "2.25.2" 561 | (cons x `(a ,x c)) 562 | `(d a ,x c)) 563 | 564 | (test-check "2.26" 565 | (run* (l) 566 | (fresh (x) 567 | (== `(d a ,x c) l) 568 | (conso x `(a ,x c) l))) 569 | (list `(d a d c))) 570 | 571 | (test-check "2.27" 572 | (run* (l) 573 | (fresh (x) 574 | (conso x `(a ,x c) l) 575 | (== `(d a ,x c) l))) 576 | (list `(d a d c))) 577 | 578 | (test-check "2.29" 579 | (run* (l) 580 | (fresh (d x y w s) 581 | (conso w '(a n s) s) 582 | (cdro l s) 583 | (caro l x) 584 | (== 'b x) 585 | (cdro l d) 586 | (caro d y) 587 | (== 'e y))) 588 | (list `(b e a n s))) 589 | 590 | (test-check "2.30" 591 | (null? `(grape raisin pear)) 592 | #f) 593 | 594 | (test-check "2.31" 595 | (null? '()) 596 | #t) 597 | 598 | ; 2.35 599 | (define nullo 600 | (lambda (x) 601 | (== '() x))) 602 | 603 | (test-check "2.32" 604 | (run* (q) 605 | (nullo `(grape raisin pear)) 606 | (== #t q)) 607 | `()) 608 | 609 | (test-check "2.33" 610 | (run* (q) 611 | (nullo '()) 612 | (== #t q)) 613 | `(#t)) 614 | 615 | (test-check "2.34" 616 | (run* (x) 617 | (nullo x)) 618 | `(())) 619 | 620 | (test-check "2.36" 621 | (eq? 'pear 'plum) 622 | #f) 623 | 624 | (test-check "2.37" 625 | (eq? 'plum 'plum) 626 | #t) 627 | 628 | ; 2.40 629 | (define eqo 630 | (lambda (x y) 631 | (== x y))) 632 | 633 | (test-check "2.38" 634 | (run* (q) 635 | (eqo 'pear 'plum) 636 | (== #t q)) 637 | `()) 638 | 639 | (test-check "2.39" 640 | (run* (q) 641 | (eqo 'plum 'plum) 642 | (== #t q)) 643 | `(#t)) 644 | 645 | (test-check "2.43" 646 | (pair? `((split) . pea)) 647 | #t) 648 | 649 | (test-check "2.44" 650 | (pair? '()) 651 | #f) 652 | 653 | (test-check "2.48" 654 | (car `(pear)) 655 | `pear) 656 | 657 | (test-check "2.49" 658 | (cdr `(pear)) 659 | `()) 660 | 661 | (test-check "2.51" 662 | (cons `(split) 'pea) 663 | `((split) . pea)) 664 | 665 | (test-check "2.52" 666 | (run* (r) 667 | (fresh (x y) 668 | (== (cons x (cons y 'salad)) r))) 669 | (list `(_.0 _.1 . salad))) 670 | 671 | ; 2.53 672 | (define pairo 673 | (lambda (p) 674 | (fresh (a d) 675 | (conso a d p)))) 676 | 677 | (test-check "2.54" 678 | (run* (q) 679 | (pairo (cons q q)) 680 | (== #t q)) 681 | `(#t)) 682 | 683 | (test-check "2.55" 684 | (run* (q) 685 | (pairo '()) 686 | (== #t q)) 687 | `()) 688 | 689 | (test-check "2.56" 690 | (run* (q) 691 | (pairo 'pair) 692 | (== #t q)) 693 | `()) 694 | 695 | (test-check "2.57" 696 | (run* (x) 697 | (pairo x)) 698 | (list `(_.0 . _.1))) 699 | 700 | (test-check "2.58" 701 | (run* (r) 702 | (pairo (cons r 'pear))) 703 | (list `_.0)) 704 | 705 | ; 3.1.1 706 | '(define list? 707 | (lambda (l) 708 | (cond 709 | ((null? l) #t) 710 | ((pair? l) (list? (cdr l))) 711 | (else #f)))) 712 | 713 | (test-check "3.1.1" 714 | (list? `((a) (a b) c)) 715 | #t) 716 | 717 | (test-check "3.2" 718 | (list? `()) 719 | #t) 720 | 721 | (test-check "3.3" 722 | (list? 's) 723 | #f) 724 | 725 | (test-check "3.4" 726 | (list? `(d a t e . s)) 727 | #f) 728 | 729 | ; 3.5 730 | (define listo 731 | (lambda (l) 732 | (conde 733 | ((nullo l) succeed) 734 | ((pairo l) 735 | (fresh (d) 736 | (cdro l d) 737 | (listo d))) 738 | (else fail)))) 739 | 740 | (test-check "3.7" 741 | (run* (x) 742 | (listo `(a b ,x d))) 743 | (list `_.0)) 744 | 745 | (test-check "3.10" 746 | (run 1 (x) 747 | (listo `(a b c . ,x))) 748 | (list `())) 749 | 750 | (test-divergence "3.13" 751 | (run* (x) 752 | (listo `(a b c . ,x)))) 753 | 754 | (test-check "3.14" 755 | (run 5 (x) 756 | (listo `(a b c . ,x))) 757 | `(() 758 | (_.0) 759 | (_.0 _.1) 760 | (_.0 _.1 _.2) 761 | (_.0 _.1 _.2 _.3))) 762 | 763 | ; 3.16 764 | (define lol? 765 | (lambda (l) 766 | (cond 767 | ((null? l) #t) 768 | ((list? (car l)) (lol? (cdr l))) 769 | (else #f)))) 770 | 771 | ; 3.17 772 | (define lolo 773 | (lambda (l) 774 | (conde 775 | ((nullo l) succeed) 776 | ((fresh (a) 777 | (caro l a) 778 | (listo a)) 779 | (fresh (d) 780 | (cdro l d) 781 | (lolo d))) 782 | (else fail)))) 783 | 784 | (test-check "3.20" 785 | (run 1 (l) 786 | (lolo l)) 787 | `(())) 788 | 789 | (test-check "3.21" 790 | (run* (q) 791 | (fresh (x y) 792 | (lolo `((a b) (,x c) (d ,y))) 793 | (== #t q))) 794 | (list #t)) 795 | 796 | (test-check "3.22" 797 | (run 1 (q) 798 | (fresh (x) 799 | (lolo `((a b) . ,x)) 800 | (== #t q))) 801 | (list #t)) 802 | 803 | (test-check "3.23" 804 | (run 1 (x) 805 | (lolo `((a b) (c d) . ,x))) 806 | `(())) 807 | 808 | (test-check "3.24" 809 | (run 5 (x) 810 | (lolo `((a b) (c d) . ,x))) 811 | `(() 812 | (()) 813 | (() ()) 814 | (() () ()) 815 | (() () () ()))) 816 | 817 | ; 3.31 818 | (define twinso 819 | (lambda (s) 820 | (fresh (x y) 821 | (conso x y s) 822 | (conso x '() y)))) 823 | 824 | (test-check "3.32" 825 | (run* (q) 826 | (twinso '(tofu tofu)) 827 | (== #t q)) 828 | (list #t)) 829 | 830 | (test-check "3.33" 831 | (run* (z) 832 | (twinso `(,z tofu))) 833 | (list `tofu)) 834 | 835 | ; 3.36 836 | (define twinso 837 | (lambda (s) 838 | (fresh (x) 839 | (== `(,x ,x) s)))) 840 | 841 | ; 3.37 842 | (define loto 843 | (lambda (l) 844 | (conde 845 | ((nullo l) succeed) 846 | ((fresh (a) 847 | (caro l a) 848 | (twinso a)) 849 | (fresh (d) 850 | (cdro l d) 851 | (loto d))) 852 | (else fail)))) 853 | 854 | (test-check "3.38" 855 | (run 1 (z) 856 | (loto `((g g) . ,z))) 857 | (list `())) 858 | 859 | (test-check "3.42" 860 | (run 5 (z) 861 | (loto `((g g) . ,z))) 862 | '(() 863 | ((_.0 _.0)) 864 | ((_.0 _.0) (_.1 _.1)) 865 | ((_.0 _.0) (_.1 _.1) (_.2 _.2)) 866 | ((_.0 _.0) (_.1 _.1) (_.2 _.2) (_.3 _.3)))) 867 | 868 | (test-check "3.45" 869 | (run 5 (r) 870 | (fresh (w x y z) 871 | (loto `((g g) (e ,w) (,x ,y) . ,z)) 872 | (== `(,w (,x ,y) ,z) r))) 873 | '((e (_.0 _.0) ()) 874 | (e (_.0 _.0) ((_.1 _.1))) 875 | (e (_.0 _.0) ((_.1 _.1) (_.2 _.2))) 876 | (e (_.0 _.0) ((_.1 _.1) (_.2 _.2) (_.3 _.3))) 877 | (e (_.0 _.0) ((_.1 _.1) (_.2 _.2) (_.3 _.3) (_.4 _.4))))) 878 | 879 | (test-check "3.47" 880 | (run 3 (out) 881 | (fresh (w x y z) 882 | (== `((g g) (e ,w) (,x ,y) . ,z) out) 883 | (loto out))) 884 | `(((g g) (e e) (_.0 _.0)) 885 | ((g g) (e e) (_.0 _.0) (_.1 _.1)) 886 | ((g g) (e e) (_.0 _.0) (_.1 _.1) (_.2 _.2)))) 887 | 888 | ; 3.48 889 | (define listofo 890 | (lambda (predo l) 891 | (conde 892 | ((nullo l) succeed) 893 | ((fresh (a) 894 | (caro l a) 895 | (predo a)) 896 | (fresh (d) 897 | (cdro l d) 898 | (listofo predo d))) 899 | (else fail)))) 900 | 901 | (test-check "3.49" 902 | (run 3 (out) 903 | (fresh (w x y z) 904 | (== `((g g) (e ,w) (,x ,y) . ,z) out) 905 | (listofo twinso out))) 906 | `(((g g) (e e) (_.0 _.0)) 907 | ((g g) (e e) (_.0 _.0) (_.1 _.1)) 908 | ((g g) (e e) (_.0 _.0) (_.1 _.1) (_.2 _.2)))) 909 | 910 | ; 3.50 911 | (define loto 912 | (lambda (l) 913 | (listofo twinso l))) 914 | 915 | ; 3.51.1 916 | (define member? 917 | (lambda (x l) 918 | (cond 919 | ((null? l) nil) 920 | ((eq-car? l x) #t) 921 | (else (member? x (cdr l)))))) 922 | 923 | ; 3.51.2 924 | (define eq-car? 925 | (lambda (l x) 926 | (eq? (car l) x))) 927 | 928 | ; 3.53 929 | (test-check "3-21" 930 | (member? 'olive `(virgin olive oil)) 931 | #t) 932 | 933 | ; 3.54.1 934 | (define eq-caro 935 | (lambda (l x) 936 | (caro l x))) 937 | 938 | ; 3.54.2 939 | (define membero 940 | (lambda (x l) 941 | (conde 942 | ((nullo l) fail) 943 | ((eq-caro l x) succeed) 944 | (else 945 | (fresh (d) 946 | (cdro l d) 947 | (membero x d)))))) 948 | 949 | (test-check "3.57" 950 | (run* (q) 951 | (membero 'olive `(virgin olive oil)) 952 | (== #t q)) 953 | (list #t)) 954 | 955 | (test-check "3.58" 956 | (run 1 (y) 957 | (membero y `(hummus with pita))) 958 | (list `hummus)) 959 | 960 | (test-check "3.59" 961 | (run 1 (y) 962 | (membero y `(with pita))) 963 | (list `with)) 964 | 965 | (test-check "3.60" 966 | (run 1 (y) 967 | (membero y `(pita))) 968 | (list `pita)) 969 | 970 | (test-check "3.61" 971 | (run* (y) 972 | (membero y `())) 973 | `()) 974 | 975 | (test-check "3.62" 976 | (run* (y) 977 | (membero y `(hummus with pita))) 978 | `(hummus with pita)) 979 | 980 | ; 3.65 981 | (define identity 982 | (lambda (l) 983 | (run* (y) 984 | (membero y l)))) 985 | 986 | (test-check "3.66" 987 | (run* (x) 988 | (membero 'e `(pasta ,x fagioli))) 989 | (list `e)) 990 | 991 | (test-check "3.69" 992 | (run 1 (x) 993 | (membero 'e `(pasta e ,x fagioli))) 994 | (list `_.0)) 995 | 996 | (test-check "3.70" 997 | (run 1 (x) 998 | (membero 'e `(pasta ,x e fagioli))) 999 | (list `e)) 1000 | 1001 | (test-check "3.71" 1002 | (run* (r) 1003 | (fresh (x y) 1004 | (membero 'e `(pasta ,x fagioli ,y)) 1005 | (== `(,x ,y) r))) 1006 | `((e _.0) (_.0 e))) 1007 | 1008 | (test-check "3.73" 1009 | (run 1 (l) 1010 | (membero 'tofu l)) 1011 | `((tofu . _.0))) 1012 | 1013 | (test-divergence "3.75" 1014 | (run* (l) 1015 | (membero 'tofu l))) 1016 | 1017 | (test-check "3.76" 1018 | (run 5 (l) 1019 | (membero 'tofu l)) 1020 | `((tofu . _.0) 1021 | (_.0 tofu . _.1) 1022 | (_.0 _.1 tofu . _.2) 1023 | (_.0 _.1 _.2 tofu . _.3) 1024 | (_.0 _.1 _.2 _.3 tofu . _.4))) 1025 | 1026 | ; 3.80.1 1027 | (define pmembero 1028 | (lambda (x l) 1029 | (conde 1030 | ((nullo l) fail) 1031 | ((eq-caro l x) (cdro l '())) 1032 | (else 1033 | (fresh (d) 1034 | (cdro l d) 1035 | (pmembero x d)))))) 1036 | 1037 | (test-check "3.80.2" 1038 | (run 5 (l) 1039 | (pmembero 'tofu l)) 1040 | `((tofu) 1041 | (_.0 tofu) 1042 | (_.0 _.1 tofu) 1043 | (_.0 _.1 _.2 tofu) 1044 | (_.0 _.1 _.2 _.3 tofu))) 1045 | 1046 | (test-check "3.81" 1047 | (run* (q) 1048 | (pmembero 'tofu `(a b tofu d tofu)) 1049 | (== #t q)) 1050 | `(#t)) 1051 | 1052 | ; 3.83 1053 | (define pmembero 1054 | (lambda (x l) 1055 | (conde 1056 | ((nullo l) fail) 1057 | ((eq-caro l x) (cdro l '())) 1058 | ((eq-caro l x) succeed) 1059 | (else 1060 | (fresh (d) 1061 | (cdro l d) 1062 | (pmembero x d)))))) 1063 | 1064 | (test-check "3.84" 1065 | (run* (q) 1066 | (pmembero 'tofu `(a b tofu d tofu)) 1067 | (== #t q)) 1068 | `(#t #t #t)) 1069 | 1070 | ; 3.86 1071 | (define pmembero 1072 | (lambda (x l) 1073 | (conde 1074 | ((nullo l) fail) 1075 | ((eq-caro l x) (cdro l '())) 1076 | ((eq-caro l x) 1077 | (fresh (a d) 1078 | (cdro l `(,a . ,d)))) 1079 | (else 1080 | (fresh (d) 1081 | (cdro l d) 1082 | (pmembero x d)))))) 1083 | 1084 | (test-check "3.88" 1085 | (run* (q) 1086 | (pmembero 'tofu `(a b tofu d tofu)) 1087 | (== #t q)) 1088 | `(#t #t)) 1089 | 1090 | (test-check "3.89" 1091 | (run 12 (l) 1092 | (pmembero 'tofu l)) 1093 | `((tofu) 1094 | (tofu _.0 . _.1) 1095 | (_.0 tofu) 1096 | (_.0 tofu _.1 . _.2) 1097 | (_.0 _.1 tofu) 1098 | (_.0 _.1 tofu _.2 . _.3) 1099 | (_.0 _.1 _.2 tofu) 1100 | (_.0 _.1 _.2 tofu _.3 . _.4) 1101 | (_.0 _.1 _.2 _.3 tofu) 1102 | (_.0 _.1 _.2 _.3 tofu _.4 . _.5) 1103 | (_.0 _.1 _.2 _.3 _.4 tofu) 1104 | (_.0 _.1 _.2 _.3 _.4 tofu _.5 . _.6))) 1105 | 1106 | ; 3.93 1107 | (define pmembero 1108 | (lambda (x l) 1109 | (conde 1110 | ((eq-caro l x) 1111 | (fresh (a d) 1112 | (cdro l `(,a . ,d)))) 1113 | ((eq-caro l x) (cdro l '())) 1114 | (else 1115 | (fresh (d) 1116 | (cdro l d) 1117 | (pmembero x d)))))) 1118 | 1119 | (test-check "3.94" 1120 | (run 12 (l) 1121 | (pmembero 'tofu l)) 1122 | `((tofu _.0 . _.1) 1123 | (tofu) 1124 | (_.0 tofu _.1 . _.2) 1125 | (_.0 tofu) 1126 | (_.0 _.1 tofu _.2 . _.3) 1127 | (_.0 _.1 tofu) 1128 | (_.0 _.1 _.2 tofu _.3 . _.4) 1129 | (_.0 _.1 _.2 tofu) 1130 | (_.0 _.1 _.2 _.3 tofu _.4 . _.5) 1131 | (_.0 _.1 _.2 _.3 tofu) 1132 | (_.0 _.1 _.2 _.3 _.4 tofu _.5 . _.6) 1133 | (_.0 _.1 _.2 _.3 _.4 tofu))) 1134 | 1135 | ; 3.95 1136 | (define first-value 1137 | (lambda (l) 1138 | (run 1 (y) 1139 | (membero y l)))) 1140 | 1141 | (test-check "3.96" 1142 | (first-value `(pasta e fagioli)) 1143 | `(pasta)) 1144 | 1145 | (test-check "3.97" 1146 | (first-value `(pasta e fagioli)) 1147 | (list `pasta)) 1148 | 1149 | ; 3.98 1150 | (define memberrevo 1151 | (lambda (x l) 1152 | (conde 1153 | ((nullo l) fail) 1154 | (succeed 1155 | (fresh (d) 1156 | (cdro l d) 1157 | (memberrevo x d))) 1158 | (else (eq-caro l x))))) 1159 | 1160 | (test-check "3.100" 1161 | (run* (x) 1162 | (memberrevo x `(pasta e fagioli))) 1163 | `(fagioli e pasta)) 1164 | 1165 | ; 3.101 1166 | (define reverse-list 1167 | (lambda (l) 1168 | (run* (y) 1169 | (memberrevo y l)))) 1170 | 1171 | ; 4.1.1 1172 | (define mem 1173 | (lambda (x l) 1174 | (cond 1175 | ((null? l) #f) 1176 | ((eq-car? l x) l) 1177 | (else (mem x (cdr l)))))) 1178 | 1179 | (test-check "4.1.2" 1180 | (mem 'tofu `(a b tofu d peas e)) 1181 | `(tofu d peas e)) 1182 | 1183 | (test-check "4.2" 1184 | (mem 'tofu `(a b peas d peas e)) 1185 | #f) 1186 | 1187 | (test-check "4.3" 1188 | (run* (out) 1189 | (== (mem 'tofu `(a b tofu d peas e)) out)) 1190 | (list `(tofu d peas e))) 1191 | 1192 | (test-check "4.4" 1193 | (mem 'peas (mem 'tofu `(a b tofu d peas e))) 1194 | `(peas e)) 1195 | 1196 | (test-check "4.5" 1197 | (mem 'tofu (mem 'tofu `(a b tofu d tofu e))) 1198 | `(tofu d tofu e)) 1199 | 1200 | (test-check "4.6" 1201 | (mem 'tofu (cdr (mem 'tofu `(a b tofu d tofu e)))) 1202 | `(tofu e)) 1203 | 1204 | ; 4.7 1205 | (define memo 1206 | (lambda (x l out) 1207 | (conde 1208 | ((nullo l) fail) 1209 | ((eq-caro l x) (== l out)) 1210 | (else 1211 | (fresh (d) 1212 | (cdro l d) 1213 | (memo x d out)))))) 1214 | 1215 | (test-check "4.10" 1216 | (run 1 (out) 1217 | (memo 'tofu `(a b tofu d tofu e) out)) 1218 | `((tofu d tofu e))) 1219 | 1220 | (test-check "4.11" 1221 | (run 1 (out) 1222 | (fresh (x) 1223 | (memo 'tofu `(a b ,x d tofu e) out))) 1224 | `((tofu d tofu e))) 1225 | 1226 | (test-check "4.12" 1227 | (run* (r) 1228 | (memo r `(a b tofu d tofu e) `(tofu d tofu e))) 1229 | (list `tofu)) 1230 | 1231 | (test-check "4.13" 1232 | (run* (q) 1233 | (memo 'tofu '(tofu e) '(tofu e)) 1234 | (== #t q)) 1235 | (list #t)) 1236 | 1237 | (test-check "4.14" 1238 | (run* (q) 1239 | (memo 'tofu '(tofu e) '(tofu)) 1240 | (== #t q)) 1241 | `()) 1242 | 1243 | (test-check "4.15" 1244 | (run* (x) 1245 | (memo 'tofu '(tofu e) `(,x e))) 1246 | (list `tofu)) 1247 | 1248 | (test-check "4.16" 1249 | (run* (x) 1250 | (memo 'tofu '(tofu e) `(peas ,x))) 1251 | `()) 1252 | 1253 | (test-check "4.17" 1254 | (run* (out) 1255 | (fresh (x) 1256 | (memo 'tofu `(a b ,x d tofu e) out))) 1257 | `((tofu d tofu e) (tofu e))) 1258 | 1259 | (test-check "4.18" 1260 | (run 12 (z) 1261 | (fresh (u) 1262 | (memo 'tofu `(a b tofu d tofu e . ,z) u))) 1263 | `(_.0 1264 | _.0 1265 | (tofu . _.0) 1266 | (_.0 tofu . _.1) 1267 | (_.0 _.1 tofu . _.2) 1268 | (_.0 _.1 _.2 tofu . _.3) 1269 | (_.0 _.1 _.2 _.3 tofu . _.4) 1270 | (_.0 _.1 _.2 _.3 _.4 tofu . _.5) 1271 | (_.0 _.1 _.2 _.3 _.4 _.5 tofu . _.6) 1272 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 tofu . _.7) 1273 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 tofu . _.8) 1274 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 tofu . _.9))) 1275 | 1276 | ; 4.21 1277 | (define memo 1278 | (lambda (x l out) 1279 | (conde 1280 | ((eq-caro l x) (== l out)) 1281 | (else 1282 | (fresh (d) 1283 | (cdro l d) 1284 | (memo x d out)))))) 1285 | 1286 | ; 4.22 1287 | (define rember 1288 | (lambda (x l) 1289 | (cond 1290 | ((null? l) '()) 1291 | ((eq-car? l x) (cdr l)) 1292 | (else 1293 | (cons (car l) 1294 | (rember x (cdr l))))))) 1295 | 1296 | (test-check "4.23" 1297 | (rember 'peas '(a b peas d peas e)) 1298 | `(a b d peas e)) 1299 | 1300 | ; 4.24 1301 | (define rembero 1302 | (lambda (x l out) 1303 | (conde 1304 | ((nullo l) (== '() out)) 1305 | ((eq-caro l x) (cdro l out)) 1306 | (else 1307 | (fresh (res) 1308 | (fresh (d) 1309 | (cdro l d) 1310 | (rembero x d res)) 1311 | (fresh (a) 1312 | (caro l a) 1313 | (conso a res out))))))) 1314 | 1315 | ; 4.27 1316 | (define rembero 1317 | (lambda (x l out) 1318 | (conde 1319 | ((nullo l) (== '() out)) 1320 | ((eq-caro l x) (cdro l out)) 1321 | (else (fresh (a d res) 1322 | (conso a d l) 1323 | (rembero x d res) 1324 | (conso a res out)))))) 1325 | 1326 | (test-check "4.30" 1327 | (run 1 (out) 1328 | (fresh (y) 1329 | (rembero 'peas `(a b ,y d peas e) out))) 1330 | `((a b d peas e))) 1331 | 1332 | (test-check "4.31" 1333 | (run* (out) 1334 | (fresh (y z) 1335 | (rembero y `(a b ,y d ,z e) out))) 1336 | `((b a d _.0 e) 1337 | (a b d _.0 e) 1338 | (a b d _.0 e) 1339 | (a b d _.0 e) 1340 | (a b _.0 d e) 1341 | (a b e d _.0) 1342 | (a b _.0 d _.1 e))) 1343 | 1344 | (test-check "4.49" 1345 | (run* (r) 1346 | (fresh (y z) 1347 | (rembero y `(,y d ,z e) `(,y d e)) 1348 | (== `(,y ,z) r))) 1349 | `((d d) 1350 | (d d) 1351 | (_.0 _.0) 1352 | (e e))) 1353 | 1354 | (test-check "4.57" 1355 | (run 13 (w) 1356 | (fresh (y z out) 1357 | (rembero y `(a b ,y d ,z . ,w) out))) 1358 | `(_.0 1359 | _.0 1360 | _.0 1361 | _.0 1362 | _.0 1363 | () 1364 | (_.0 . _.1) 1365 | (_.0) 1366 | (_.0 _.1 . _.2) 1367 | (_.0 _.1) 1368 | (_.0 _.1 _.2 . _.3) 1369 | (_.0 _.1 _.2) 1370 | (_.0 _.1 _.2 _.3 . _.4))) 1371 | 1372 | ; 4.68 1373 | (define surpriseo 1374 | (lambda (s) 1375 | (rembero s '(a b c) '(a b c)))) 1376 | 1377 | (test-check "4.69" 1378 | (run* (r) 1379 | (== 'd r) 1380 | (surpriseo r)) 1381 | (list 'd)) 1382 | 1383 | (test-check "4.70" 1384 | (run* (r) 1385 | (surpriseo r)) 1386 | `(_.0)) 1387 | 1388 | (test-check "4.72" 1389 | (run* (r) 1390 | (== 'b r) 1391 | (surpriseo r)) 1392 | `(b)) 1393 | 1394 | ; 5.2.1 1395 | '(define append 1396 | (lambda (l s) 1397 | (cond 1398 | ((null? l) s) 1399 | (else (cons (car l) 1400 | (append (cdr l) s)))))) 1401 | 1402 | (test-check "5.2.2" 1403 | (append `(a b c) `(d e)) 1404 | `(a b c d e)) 1405 | 1406 | (test-check "5.3" 1407 | (append '(a b c) '()) 1408 | `(a b c)) 1409 | 1410 | (test-check "5.4" 1411 | (append '() '(d e)) 1412 | `(d e)) 1413 | 1414 | (test-check "5.6" 1415 | (append '(d e) 'a) 1416 | `(d e . a)) 1417 | 1418 | ; 5.9 1419 | (define appendo 1420 | (lambda (l s out) 1421 | (conde 1422 | ((nullo l) (== s out)) 1423 | (else 1424 | (fresh (a d res) 1425 | (caro l a) 1426 | (cdro l d) 1427 | (appendo d s res) 1428 | (conso a res out)))))) 1429 | 1430 | (test-check "5.10" 1431 | (run* (x) 1432 | (appendo 1433 | '(cake) 1434 | '(tastes yummy) 1435 | x)) 1436 | (list `(cake tastes yummy))) 1437 | 1438 | (test-check "5.11" 1439 | (run* (x) 1440 | (fresh (y) 1441 | (appendo 1442 | `(cake with ice ,y) 1443 | '(tastes yummy) 1444 | x))) 1445 | (list `(cake with ice _.0 tastes yummy))) 1446 | 1447 | (test-check "5.12" 1448 | (run* (x) 1449 | (fresh (y) 1450 | (appendo 1451 | '(cake with ice cream) 1452 | y 1453 | x))) 1454 | (list `(cake with ice cream . _.0))) 1455 | 1456 | (test-check "5.13" 1457 | (run 1 (x) 1458 | (fresh (y) 1459 | (appendo `(cake with ice . ,y) '(d t) x))) 1460 | (list `(cake with ice d t))) 1461 | 1462 | (test-check "5.14" 1463 | (run 1 (y) 1464 | (fresh (x) 1465 | (appendo `(cake with ice . ,y) '(d t) x))) 1466 | (list '())) 1467 | 1468 | ; 5.15 1469 | (define appendo 1470 | (lambda (l s out) 1471 | (conde 1472 | ((nullo l) (== s out)) 1473 | (else 1474 | (fresh (a d res) 1475 | (conso a d l) 1476 | (appendo d s res) 1477 | (conso a res out)))))) 1478 | 1479 | (test-check "5.16" 1480 | (run 5 (x) 1481 | (fresh (y) 1482 | (appendo `(cake with ice . ,y) '(d t) x))) 1483 | `((cake with ice d t) 1484 | (cake with ice _.0 d t) 1485 | (cake with ice _.0 _.1 d t) 1486 | (cake with ice _.0 _.1 _.2 d t) 1487 | (cake with ice _.0 _.1 _.2 _.3 d t))) 1488 | 1489 | (test-check "5.17" 1490 | (run 5 (y) 1491 | (fresh (x) 1492 | (appendo `(cake with ice . ,y) '(d t) x))) 1493 | `(() 1494 | (_.0) 1495 | (_.0 _.1) 1496 | (_.0 _.1 _.2) 1497 | (_.0 _.1 _.2 _.3))) 1498 | 1499 | (define y `(_.0 _.1 _.2)) 1500 | 1501 | (test-check "5.18" 1502 | `(cake with ice . ,y) 1503 | `(cake with ice . (_.0 _.1 _.2))) 1504 | 1505 | (test-check "5.20" 1506 | (run 5 (x) 1507 | (fresh (y) 1508 | (appendo 1509 | `(cake with ice . ,y) 1510 | `(d t . ,y) 1511 | x))) 1512 | `((cake with ice d t) 1513 | (cake with ice _.0 d t _.0) 1514 | (cake with ice _.0 _.1 d t _.0 _.1) 1515 | (cake with ice _.0 _.1 _.2 d t _.0 _.1 _.2) 1516 | (cake with ice _.0 _.1 _.2 _.3 d t _.0 _.1 _.2 _.3))) 1517 | 1518 | (test-check "5.21" 1519 | (run* (x) 1520 | (fresh (z) 1521 | (appendo 1522 | `(cake with ice cream) 1523 | `(d t . ,z) 1524 | x))) 1525 | `((cake with ice cream d t . _.0))) 1526 | 1527 | (test-check "5.23" 1528 | (run 6 (x) 1529 | (fresh (y) 1530 | (appendo x y `(cake with ice d t)))) 1531 | `(() 1532 | (cake) 1533 | (cake with) 1534 | (cake with ice) 1535 | (cake with ice d) 1536 | (cake with ice d t))) 1537 | 1538 | (test-check "5.25" 1539 | (run 6 (y) 1540 | (fresh (x) 1541 | (appendo x y `(cake with ice d t)))) 1542 | `((cake with ice d t) 1543 | (with ice d t) 1544 | (ice d t) 1545 | (d t) 1546 | (t) 1547 | ())) 1548 | 1549 | ; 5.26.1 1550 | (define appendxyquestion 1551 | (lambda () 1552 | (run 6 (r) 1553 | (fresh (x y) 1554 | (appendo x y `(cake with ice d t)) 1555 | (== `(,x ,y) r))))) 1556 | 1557 | ; 5.26.2 1558 | (define appendxyanswer 1559 | `((() (cake with ice d t)) 1560 | ((cake) (with ice d t)) 1561 | ((cake with) (ice d t)) 1562 | ((cake with ice) (d t)) 1563 | ((cake with ice d) (t)) 1564 | ((cake with ice d t) ()))) 1565 | 1566 | (test-check "appendxy" 1567 | (appendxyquestion) 1568 | appendxyanswer) 1569 | 1570 | (test-divergence "5.29" 1571 | (run 7 (r) 1572 | (fresh (x y) 1573 | (appendo x y `(cake with ice d t)) 1574 | (== `(,x ,y) r)))) 1575 | 1576 | ; 5.31 1577 | (define appendo 1578 | (lambda (l s out) 1579 | (conde 1580 | ((nullo l) (== s out)) 1581 | (else 1582 | (fresh (a d res) 1583 | (conso a d l) 1584 | (conso a res out) 1585 | (appendo d s res)))))) 1586 | 1587 | (test-check "5.32" 1588 | (run 7 (r) 1589 | (fresh (x y) 1590 | (appendo x y `(cake with ice d t)) 1591 | (== `(,x ,y) r))) 1592 | appendxyanswer) 1593 | 1594 | (test-check "5.33" 1595 | (run 7 (x) 1596 | (fresh (y z) 1597 | (appendo x y z))) 1598 | `(() 1599 | (_.0) 1600 | (_.0 _.1) 1601 | (_.0 _.1 _.2) 1602 | (_.0 _.1 _.2 _.3) 1603 | (_.0 _.1 _.2 _.3 _.4) 1604 | (_.0 _.1 _.2 _.3 _.4 _.5))) 1605 | 1606 | (test-check "5.34" 1607 | (run 7 (y) 1608 | (fresh (x z) 1609 | (appendo x y z))) 1610 | `(_.0 1611 | _.0 1612 | _.0 1613 | _.0 1614 | _.0 1615 | _.0 1616 | _.0)) 1617 | 1618 | (test-check "5.36" 1619 | (run 7 (z) 1620 | (fresh (x y) 1621 | (appendo x y z))) 1622 | `(_.0 1623 | (_.0 . _.1) 1624 | (_.0 _.1 . _.2) 1625 | (_.0 _.1 _.2 . _.3) 1626 | (_.0 _.1 _.2 _.3 . _.4) 1627 | (_.0 _.1 _.2 _.3 _.4 . _.5) 1628 | (_.0 _.1 _.2 _.3 _.4 _.5 . _.6))) 1629 | 1630 | (test-check "5.37" 1631 | (run 7 (r) 1632 | (fresh (x y z) 1633 | (appendo x y z) 1634 | (== `(,x ,y ,z) r))) 1635 | `((() _.0 _.0) 1636 | ((_.0) _.1 (_.0 . _.1)) 1637 | ((_.0 _.1) _.2 (_.0 _.1 . _.2)) 1638 | ((_.0 _.1 _.2) _.3 (_.0 _.1 _.2 . _.3)) 1639 | ((_.0 _.1 _.2 _.3) _.4 (_.0 _.1 _.2 _.3 . _.4)) 1640 | ((_.0 _.1 _.2 _.3 _.4) _.5 (_.0 _.1 _.2 _.3 _.4 . _.5)) 1641 | ((_.0 _.1 _.2 _.3 _.4 _.5) _.6 (_.0 _.1 _.2 _.3 _.4 _.5 . _.6)))) 1642 | 1643 | ; 5.38 1644 | (define swappendo 1645 | (lambda (l s out) 1646 | (conde 1647 | (succeed 1648 | (fresh (a d res) 1649 | (conso a d l) 1650 | (conso a res out) 1651 | (swappendo d s res))) 1652 | (else (nullo l) (== s out))))) 1653 | 1654 | (test-divergence "5.39" 1655 | (run 1 (z) 1656 | (fresh (x y) 1657 | (swappendo x y z)))) 1658 | 1659 | ; 5.41.1 1660 | (define unwrap 1661 | (lambda (x) 1662 | (cond 1663 | ((pair? x) (unwrap (car x))) 1664 | (else x)))) 1665 | 1666 | (test-check "5.41.2" 1667 | (unwrap '((((pizza))))) 1668 | `pizza) 1669 | 1670 | (test-check "5.42" 1671 | (unwrap '((((pizza pie) with)) extra cheese)) 1672 | `pizza) 1673 | 1674 | ; 5.45 1675 | (define unwrapo 1676 | (lambda (x out) 1677 | (conde 1678 | ((pairo x) 1679 | (fresh (a) 1680 | (caro x a) 1681 | (unwrapo a out))) 1682 | (else (== x out))))) 1683 | 1684 | (test-check "5.46" 1685 | (run* (x) 1686 | (unwrapo '(((pizza))) x)) 1687 | `(pizza 1688 | (pizza) 1689 | ((pizza)) 1690 | (((pizza))))) 1691 | 1692 | (test-divergence "5.48" 1693 | (run 1 (x) 1694 | (unwrapo x 'pizza))) 1695 | 1696 | (test-divergence "5.49" 1697 | (run 1 (x) 1698 | (unwrapo `((,x)) 'pizza))) 1699 | 1700 | ; 5.52 1701 | (define unwrapo 1702 | (lambda (x out) 1703 | (conde 1704 | (succeed (== x out)) 1705 | (else 1706 | (fresh (a) 1707 | (caro x a) 1708 | (unwrapo a out)))))) 1709 | 1710 | (test-check "5.53" 1711 | (run 5 (x) 1712 | (unwrapo x 'pizza)) 1713 | `(pizza 1714 | (pizza . _.0) 1715 | ((pizza . _.0) . _.1) 1716 | (((pizza . _.0) . _.1) . _.2) 1717 | ((((pizza . _.0) . _.1) . _.2) . _.3))) 1718 | 1719 | (test-check "5.54" 1720 | (run 5 (x) 1721 | (unwrapo x '((pizza)))) 1722 | `(((pizza)) 1723 | (((pizza)) . _.0) 1724 | ((((pizza)) . _.0) . _.1) 1725 | (((((pizza)) . _.0) . _.1) . _.2) 1726 | ((((((pizza)) . _.0) . _.1) . _.2) . _.3))) 1727 | 1728 | (test-check "5.55" 1729 | (run 5 (x) 1730 | (unwrapo `((,x)) 'pizza)) 1731 | `(pizza 1732 | (pizza . _.0) 1733 | ((pizza . _.0) . _.1) 1734 | (((pizza . _.0) . _.1) . _.2) 1735 | ((((pizza . _.0) . _.1) . _.2) . _.3))) 1736 | 1737 | ; 5.58.1 1738 | (define flatten 1739 | (lambda (s) 1740 | (cond 1741 | ((null? s) '()) 1742 | ((pair? s) 1743 | (append 1744 | (flatten (car s)) 1745 | (flatten (cdr s)))) 1746 | (else (cons s '()))))) 1747 | 1748 | (test-check "5.58.1" 1749 | (flatten '((a b) c)) 1750 | `(a b c)) 1751 | 1752 | ; 5.59 1753 | (define flatteno 1754 | (lambda (s out) 1755 | (conde 1756 | ((nullo s) (== '() out)) 1757 | ((pairo s) 1758 | (fresh (a d res-a res-d) 1759 | (conso a d s) 1760 | (flatteno a res-a) 1761 | (flatteno d res-d) 1762 | (appendo res-a res-d out))) 1763 | (else (conso s '() out))))) 1764 | 1765 | (test-check "5.60" 1766 | (run 1 (x) 1767 | (flatteno '((a b) c) x)) 1768 | (list `(a b c))) 1769 | 1770 | (test-check "5.61" 1771 | (run 1 (x) 1772 | (flatteno '(a (b c)) x)) 1773 | (list `(a b c))) 1774 | 1775 | (test-check "5.62" 1776 | (run* (x) 1777 | (flatteno '(a) x)) 1778 | `((a) 1779 | (a ()) 1780 | ((a)))) 1781 | 1782 | (test-check "5.64" 1783 | (run* (x) 1784 | (flatteno '((a)) x)) 1785 | `((a) 1786 | (a ()) 1787 | (a ()) 1788 | (a () ()) 1789 | ((a)) 1790 | ((a) ()) 1791 | (((a))))) 1792 | 1793 | (test-check "5.66" 1794 | (run* (x) 1795 | (flatteno '(((a))) x)) 1796 | `((a) 1797 | (a ()) 1798 | (a ()) 1799 | (a () ()) 1800 | (a ()) 1801 | (a () ()) 1802 | (a () ()) 1803 | (a () () ()) 1804 | ((a)) 1805 | ((a) ()) 1806 | ((a) ()) 1807 | ((a) () ()) 1808 | (((a))) 1809 | (((a)) ()) 1810 | ((((a)))))) 1811 | 1812 | ; 5.68.1 1813 | (define flattenogrumblequestion 1814 | (lambda () 1815 | (run* (x) 1816 | (flatteno '((a b) c) x)) )) 1817 | 1818 | ; 5.68.2 1819 | (define flattenogrumbleanswer 1820 | `((a b c) 1821 | (a b c ()) 1822 | (a b (c)) 1823 | (a b () c) 1824 | (a b () c ()) 1825 | (a b () (c)) 1826 | (a (b) c) 1827 | (a (b) c ()) 1828 | (a (b) (c)) 1829 | ((a b) c) 1830 | ((a b) c ()) 1831 | ((a b) (c)) 1832 | (((a b) c)))) 1833 | 1834 | (test-check "flattenogrumble" 1835 | (flattenogrumblequestion) 1836 | flattenogrumbleanswer) 1837 | 1838 | (test-divergence "5.71" 1839 | (run* (x) 1840 | (flatteno x '(a b c)))) 1841 | 1842 | ; 5.73 1843 | (define flattenrevo 1844 | (lambda (s out) 1845 | (conde 1846 | (succeed (conso s '() out)) 1847 | ((nullo s) (== '() out)) 1848 | (else 1849 | (fresh (a d res-a res-d) 1850 | (conso a d s) 1851 | (flattenrevo a res-a) 1852 | (flattenrevo d res-d) 1853 | (appendo res-a res-d out)))))) 1854 | 1855 | (test-check "5.75" 1856 | (run* (x) 1857 | (flattenrevo '((a b) c) x)) 1858 | `((((a b) c)) 1859 | ((a b) (c)) 1860 | ((a b) c ()) 1861 | ((a b) c) 1862 | (a (b) (c)) 1863 | (a (b) c ()) 1864 | (a (b) c) 1865 | (a b () (c)) 1866 | (a b () c ()) 1867 | (a b () c) 1868 | (a b (c)) 1869 | (a b c ()) 1870 | (a b c))) 1871 | 1872 | (test-check "5.76" 1873 | (reverse 1874 | (run* (x) 1875 | (flattenrevo '((a b) c) x))) 1876 | flattenogrumbleanswer) 1877 | 1878 | (test-check "5.77" 1879 | (run 2 (x) 1880 | (flattenrevo x '(a b c))) 1881 | `((a b . c) 1882 | (a b c))) 1883 | 1884 | (test-divergence "5.79" 1885 | (run 3 (x) 1886 | (flattenrevo x '(a b c)))) 1887 | 1888 | (test-check "5.80" 1889 | (length 1890 | (run* (x) 1891 | (flattenrevo '((((a (((b))) c))) d) x))) 1892 | 574) 1893 | 1894 | ; 6.1 1895 | (define anyo 1896 | (lambda (g) 1897 | (conde 1898 | (g succeed) 1899 | (else (anyo g))))) 1900 | 1901 | ; 6.4 1902 | (define nevero (anyo fail)) 1903 | 1904 | (test-divergence "6.5" 1905 | (run 1 (q) 1906 | nevero 1907 | (== #t q))) 1908 | 1909 | ; 6.7 1910 | (define alwayso (anyo succeed)) 1911 | 1912 | (test-check "6.7" 1913 | (run 1 (q) 1914 | alwayso 1915 | (== #t q)) 1916 | (list #t)) 1917 | 1918 | (test-divergence "6.9" 1919 | (run* (q) 1920 | alwayso 1921 | (== #t q))) 1922 | 1923 | (test-check "6.10" 1924 | (run 5 (q) 1925 | alwayso 1926 | (== #t q)) 1927 | `(#t #t #t #t #t)) 1928 | 1929 | (test-check "6.11" 1930 | (run 5 (q) 1931 | (== #t q) 1932 | alwayso) 1933 | `(#t #t #t #t #t)) 1934 | 1935 | ; 6.12 1936 | (define salo 1937 | (lambda (g) 1938 | (conde 1939 | (succeed succeed) 1940 | (else g)))) 1941 | 1942 | (test-check "6.13" 1943 | (run 1 (q) 1944 | (salo alwayso) 1945 | (== #t q)) 1946 | `(#t)) 1947 | 1948 | (test-check "6.14" 1949 | (run 1 (q) 1950 | (salo nevero) 1951 | (== #t q)) 1952 | `(#t)) 1953 | 1954 | (test-divergence "6.15" 1955 | (run* (q) 1956 | (salo nevero) 1957 | (== #t q))) 1958 | 1959 | (test-divergence "6.16" 1960 | (run 1 (q) 1961 | (salo nevero) 1962 | fail 1963 | (== #t q))) 1964 | 1965 | (test-divergence "6.17" 1966 | (run 1 (q) 1967 | alwayso 1968 | fail 1969 | (== #t q))) 1970 | 1971 | (test-divergence "6.18" 1972 | (run 1 (q) 1973 | (conde 1974 | ((== #f q) alwayso) 1975 | (else (anyo (== #t q)))) 1976 | (== #t q))) 1977 | 1978 | (test-check "6.19" 1979 | (run 1 (q) 1980 | (condi 1981 | ((== #f q) alwayso) 1982 | (else (== #t q))) 1983 | (== #t q)) 1984 | `(#t)) 1985 | 1986 | (test-divergence "6.20" 1987 | (run 2 (q) 1988 | (condi 1989 | ((== #f q) alwayso) 1990 | (else (== #t q))) 1991 | (== #t q))) 1992 | 1993 | (test-check "6.21" 1994 | (run 5 (q) 1995 | (condi 1996 | ((== #f q) alwayso) 1997 | (else (anyo (== #t q)))) 1998 | (== #t q)) 1999 | `(#t #t #t #t #t)) 2000 | 2001 | (test-check "6.24" 2002 | (run 5 (r) 2003 | (condi 2004 | ((teacupo r) succeed) 2005 | ((== #f r) succeed) 2006 | (else fail))) 2007 | `(tea #f cup)) 2008 | 2009 | (test-check "6.25" 2010 | (run 5 (q) 2011 | (condi 2012 | ((== #f q) alwayso) 2013 | ((== #t q) alwayso) 2014 | (else fail)) 2015 | (== #t q)) 2016 | `(#t #t #t #t #t)) 2017 | 2018 | (test-divergence "6.27" 2019 | (run 5 (q) 2020 | (conde 2021 | ((== #f q) alwayso) 2022 | ((== #t q) alwayso) 2023 | (else fail)) 2024 | (== #t q))) 2025 | 2026 | (test-check "6.28" 2027 | (run 5 (q) 2028 | (conde 2029 | (alwayso succeed) 2030 | (else nevero)) 2031 | (== #t q)) 2032 | `(#t #t #t #t #t)) 2033 | 2034 | (test-divergence "6.30" 2035 | (run 5 (q) 2036 | (condi 2037 | (alwayso succeed) 2038 | (else nevero)) 2039 | (== #t q))) 2040 | 2041 | (test-divergence "6.31" 2042 | (run 1 (q) 2043 | (all 2044 | (conde 2045 | ((== #f q) succeed) 2046 | (else (== #t q))) 2047 | alwayso) 2048 | (== #t q))) 2049 | 2050 | (test-check "6.32" 2051 | (run 1 (q) 2052 | (alli 2053 | (conde 2054 | ((== #f q) succeed) 2055 | (else (== #t q))) 2056 | alwayso) 2057 | (== #t q)) 2058 | `(#t)) 2059 | 2060 | (test-check "6.33" 2061 | (run 5 (q) 2062 | (alli 2063 | (conde 2064 | ((== #f q) succeed) 2065 | (else (== #t q))) 2066 | alwayso) 2067 | (== #t q)) 2068 | `(#t #t #t #t #t)) 2069 | 2070 | (test-check "6.34" 2071 | (run 5 (q) 2072 | (alli 2073 | (conde 2074 | ((== #t q) succeed) 2075 | (else (== #f q))) 2076 | alwayso) 2077 | (== #t q)) 2078 | `(#t #t #t #t #t)) 2079 | 2080 | (test-check "6.36" 2081 | (run 5 (q) 2082 | (all 2083 | (conde 2084 | (succeed succeed) 2085 | (else nevero)) 2086 | alwayso) 2087 | (== #t q)) 2088 | `(#t #t #t #t #t)) 2089 | 2090 | (test-divergence "6.38" 2091 | (run 5 (q) 2092 | (alli 2093 | (conde 2094 | (succeed succeed) 2095 | (else nevero)) 2096 | alwayso) 2097 | (== #t q))) 2098 | 2099 | ; 7.5 2100 | (define bit-xoro 2101 | (lambda (x y r) 2102 | (conde 2103 | ((== 0 x) (== 0 y) (== 0 r)) 2104 | ((== 1 x) (== 0 y) (== 1 r)) 2105 | ((== 0 x) (== 1 y) (== 1 r)) 2106 | ((== 1 x) (== 1 y) (== 0 r)) 2107 | (else fail)))) 2108 | 2109 | (test-check "7.6" 2110 | (run* (s) 2111 | (fresh (x y) 2112 | (bit-xoro x y 0) 2113 | (== `(,x ,y) s))) 2114 | `((0 0) 2115 | (1 1))) 2116 | 2117 | (test-check "7.8" 2118 | (run* (s) 2119 | (fresh (x y) 2120 | (bit-xoro x y 1) 2121 | (== `(,x ,y) s))) 2122 | `((1 0) 2123 | (0 1))) 2124 | 2125 | (test-check "7.9" 2126 | (run* (s) 2127 | (fresh (x y r) 2128 | (bit-xoro x y r) 2129 | (== `(,x ,y ,r) s))) 2130 | `((0 0 0) 2131 | (1 0 1) 2132 | (0 1 1) 2133 | (1 1 0))) 2134 | 2135 | ; 7.10 2136 | (define bit-ando 2137 | (lambda (x y r) 2138 | (conde 2139 | ((== 0 x) (== 0 y) (== 0 r)) 2140 | ((== 1 x) (== 0 y) (== 0 r)) 2141 | ((== 0 x) (== 1 y) (== 0 r)) 2142 | ((== 1 x) (== 1 y) (== 1 r)) 2143 | (else fail)))) 2144 | 2145 | (test-check "7.11" 2146 | (run* (s) 2147 | (fresh (x y) 2148 | (bit-ando x y 1) 2149 | (== `(,x ,y) s))) 2150 | `((1 1))) 2151 | 2152 | ; 7.12.1 2153 | (define half-addero 2154 | (lambda (x y r c) 2155 | (all 2156 | (bit-xoro x y r) 2157 | (bit-ando x y c)))) 2158 | 2159 | (test-check "7.12.2" 2160 | (run* (r) 2161 | (half-addero 1 1 r 1)) 2162 | (list 0)) 2163 | 2164 | (test-check "7.13" 2165 | (run* (s) 2166 | (fresh (x y r c) 2167 | (half-addero x y r c) 2168 | (== `(,x ,y ,r ,c) s))) 2169 | `((0 0 0 0) 2170 | (1 0 1 0) 2171 | (0 1 1 0) 2172 | (1 1 0 1))) 2173 | 2174 | ; 7.15.1 2175 | (define full-addero 2176 | (lambda (b x y r c) 2177 | (fresh (w xy wz) 2178 | (half-addero x y w xy) 2179 | (half-addero w b r wz) 2180 | (bit-xoro xy wz c)))) 2181 | 2182 | (test-check "7.15.2" 2183 | (run* (s) 2184 | (fresh (r c) 2185 | (full-addero 0 1 1 r c) 2186 | (== `(,r ,c) s))) 2187 | (list `(0 1))) 2188 | 2189 | ; 7.15.3 2190 | (define full-addero 2191 | (lambda (b x y r c) 2192 | (conde 2193 | ((== 0 b) (== 0 x) (== 0 y) (== 0 r) (== 0 c)) 2194 | ((== 1 b) (== 0 x) (== 0 y) (== 1 r) (== 0 c)) 2195 | ((== 0 b) (== 1 x) (== 0 y) (== 1 r) (== 0 c)) 2196 | ((== 1 b) (== 1 x) (== 0 y) (== 0 r) (== 1 c)) 2197 | ((== 0 b) (== 0 x) (== 1 y) (== 1 r) (== 0 c)) 2198 | ((== 1 b) (== 0 x) (== 1 y) (== 0 r) (== 1 c)) 2199 | ((== 0 b) (== 1 x) (== 1 y) (== 0 r) (== 1 c)) 2200 | ((== 1 b) (== 1 x) (== 1 y) (== 1 r) (== 1 c)) 2201 | (else fail)))) 2202 | 2203 | (test-check "7.16" 2204 | (run* (s) 2205 | (fresh (r c) 2206 | (full-addero 1 1 1 r c) 2207 | (== `(,r ,c) s))) 2208 | (list `(1 1))) 2209 | 2210 | (test-check "7.17" 2211 | (run* (s) 2212 | (fresh (b x y r c) 2213 | (full-addero b x y r c) 2214 | (== `(,b ,x ,y ,r ,c) s))) 2215 | `((0 0 0 0 0) 2216 | (1 0 0 1 0) 2217 | (0 1 0 1 0) 2218 | (1 1 0 0 1) 2219 | (0 0 1 1 0) 2220 | (1 0 1 0 1) 2221 | (0 1 1 0 1) 2222 | (1 1 1 1 1))) 2223 | 2224 | ; 7.43 2225 | (define build-num 2226 | (lambda (n) 2227 | (cond 2228 | ((zero? n) '()) 2229 | ((and (not (zero? n)) (even? n)) 2230 | (cons 0 2231 | (build-num (quotient n 2)))) 2232 | ((odd? n) 2233 | (cons 1 2234 | (build-num (quotient (- n 1) 2))))))) 2235 | 2236 | (test-check "7.25" 2237 | `(1 0 1) 2238 | (build-num 5)) 2239 | 2240 | (test-check "7.26" 2241 | `(1 1 1) 2242 | (build-num 7)) 2243 | 2244 | (test-check "7.27" 2245 | (build-num 9) 2246 | `(1 0 0 1)) 2247 | 2248 | (test-check "7.28" 2249 | (build-num 6) 2250 | `(0 1 1)) 2251 | 2252 | (test-check "7.31" 2253 | (build-num 19) 2254 | `(1 1 0 0 1)) 2255 | 2256 | (test-check "7.32" 2257 | (build-num 17290) 2258 | `(0 1 0 1 0 0 0 1 1 1 0 0 0 0 1)) 2259 | 2260 | (test-check "7.40" 2261 | (build-num 0) 2262 | `()) 2263 | 2264 | (test-check "7.41" 2265 | (build-num 36) 2266 | `(0 0 1 0 0 1)) 2267 | 2268 | (test-check "7.42" 2269 | (build-num 19) 2270 | `(1 1 0 0 1)) 2271 | 2272 | ; 7.44 2273 | (define build-num 2274 | (lambda (n) 2275 | (cond 2276 | ((odd? n) 2277 | (cons 1 2278 | (build-num (quotient (- n 1) 2)))) 2279 | ((and (not (zero? n)) (even? n)) 2280 | (cons 0 2281 | (build-num (quotient n 2)))) 2282 | ((zero? n) '())))) 2283 | 2284 | ; 7.80.1 2285 | (define poso 2286 | (lambda (n) 2287 | (fresh (a d) 2288 | (== `(,a . ,d) n)))) 2289 | 2290 | (test-check "7.80.2" 2291 | (run* (q) 2292 | (poso '(0 1 1)) 2293 | (== #t q)) 2294 | (list #t)) 2295 | 2296 | (test-check "7.81" 2297 | (run* (q) 2298 | (poso '(1)) 2299 | (== #t q)) 2300 | (list #t)) 2301 | 2302 | (test-check "7.82" 2303 | (run* (q) 2304 | (poso '()) 2305 | (== #t q)) 2306 | `()) 2307 | 2308 | (test-check "7.83" 2309 | (run* (r) 2310 | (poso r)) 2311 | (list `(_.0 . _.1))) 2312 | 2313 | ; 7.86.1 2314 | (define >1o 2315 | (lambda (n) 2316 | (fresh (a ad dd) 2317 | (== `(,a ,ad . ,dd) n)))) 2318 | 2319 | (test-check "7.86.2" 2320 | (run* (q) 2321 | (>1o '(0 1 1)) 2322 | (== #t q)) 2323 | (list #t)) 2324 | 2325 | (test-check "7.87" 2326 | (run* (q) 2327 | (>1o '(0 1)) 2328 | (== #t q)) 2329 | `(#t)) 2330 | 2331 | (test-check "7.88" 2332 | (run* (q) 2333 | (>1o '(1)) 2334 | (== #t q)) 2335 | `()) 2336 | 2337 | (test-check "7.89" 2338 | (run* (q) 2339 | (>1o '()) 2340 | (== #t q)) 2341 | `()) 2342 | 2343 | (test-check "7.90" 2344 | (run* (r) 2345 | (>1o r)) 2346 | (list `(_.0 _.1 . _.2))) 2347 | 2348 | ; 7.118.1 2349 | (define addero 2350 | (lambda (d n m r) 2351 | (condi 2352 | ((== 0 d) (== '() m) (== n r)) 2353 | ((== 0 d) (== '() n) (== m r) 2354 | (poso m)) 2355 | ((== 1 d) (== '() m) 2356 | (addero 0 n '(1) r)) 2357 | ((== 1 d) (== '() n) (poso m) 2358 | (addero 0 '(1) m r)) 2359 | ((== '(1) n) (== '(1) m) 2360 | (fresh (a c) 2361 | (== `(,a ,c) r) 2362 | (full-addero d 1 1 a c))) 2363 | ((== '(1) n) (gen-addero d n m r)) 2364 | ((== '(1) m) (>1o n) (>1o r) 2365 | (addero d '(1) n r)) 2366 | ((>1o n) (gen-addero d n m r)) 2367 | (else fail)))) 2368 | 2369 | ; 7.118.2 2370 | (define gen-addero 2371 | (lambda (d n m r) 2372 | (fresh (a b c e x y z) 2373 | (== `(,a . ,x) n) 2374 | (== `(,b . ,y) m) (poso y) 2375 | (== `(,c . ,z) r) (poso z) 2376 | (alli 2377 | (full-addero d a b c e) 2378 | (addero e x y z))))) 2379 | 2380 | (test-check "7.97" 2381 | (run 3 (s) 2382 | (fresh (x y r) 2383 | (addero 0 x y r) 2384 | (== `(,x ,y ,r) s))) 2385 | `((_.0 () _.0) 2386 | (() (_.0 . _.1) (_.0 . _.1)) 2387 | ((1) (1) (0 1)))) 2388 | 2389 | (test-check "7.101" 2390 | (run 22 (s) 2391 | (fresh (x y r) 2392 | (addero 0 x y r) 2393 | (== `(,x ,y ,r) s))) 2394 | `((_.0 () _.0) 2395 | (() (_.0 . _.1) (_.0 . _.1)) 2396 | ((1) (1) (0 1)) 2397 | ((1) (0 _.0 . _.1) (1 _.0 . _.1)) 2398 | ((0 _.0 . _.1) (1) (1 _.0 . _.1)) 2399 | ((1) (1 1) (0 0 1)) 2400 | ((0 1) (0 1) (0 0 1)) 2401 | ((1) (1 0 _.0 . _.1) (0 1 _.0 . _.1)) 2402 | ((1 1) (1) (0 0 1)) 2403 | ((1) (1 1 1) (0 0 0 1)) 2404 | ((1 1) (0 1) (1 0 1)) 2405 | ((1) (1 1 0 _.0 . _.1) (0 0 1 _.0 . _.1)) 2406 | ((1 0 _.0 . _.1) (1) (0 1 _.0 . _.1)) 2407 | ((1) (1 1 1 1) (0 0 0 0 1)) 2408 | ((0 1) (0 0 _.0 . _.1) (0 1 _.0 . _.1)) 2409 | ((1) (1 1 1 0 _.0 . _.1) (0 0 0 1 _.0 . _.1)) 2410 | ((1 1 1) (1) (0 0 0 1)) 2411 | ((1) (1 1 1 1 1) (0 0 0 0 0 1)) 2412 | ((0 1) (1 1) (1 0 1)) 2413 | ((1) (1 1 1 1 0 _.0 . _.1) (0 0 0 0 1 _.0 . _.1)) 2414 | ((1 1 0 _.0 . _.1) (1) (0 0 1 _.0 . _.1)) 2415 | ((1) (1 1 1 1 1 1) (0 0 0 0 0 0 1)))) 2416 | 2417 | (test-check "7.120" 2418 | (run* (s) 2419 | (gen-addero 1 '(0 1 1) '(1 1) s)) 2420 | (list `(0 1 0 1))) 2421 | 2422 | (test-check "7.126" 2423 | (run* (s) 2424 | (fresh (x y) 2425 | (addero 0 x y '(1 0 1)) 2426 | (== `(,x ,y) s))) 2427 | `(((1 0 1) ()) 2428 | (() (1 0 1)) 2429 | ((1) (0 0 1)) 2430 | ((0 0 1) (1)) 2431 | ((1 1) (0 1)) 2432 | ((0 1) (1 1)))) 2433 | 2434 | ; 7.128 2435 | (define +o 2436 | (lambda (n m k) 2437 | (addero 0 n m k))) 2438 | 2439 | (test-check "7.129" 2440 | (run* (s) 2441 | (fresh (x y) 2442 | (+o x y '(1 0 1)) 2443 | (== `(,x ,y) s))) 2444 | `(((1 0 1) ()) 2445 | (() (1 0 1)) 2446 | ((1) (0 0 1)) 2447 | ((0 0 1) (1)) 2448 | ((1 1) (0 1)) 2449 | ((0 1) (1 1)))) 2450 | 2451 | ; 7.130 2452 | (define -o 2453 | (lambda (n m k) 2454 | (+o m k n))) 2455 | 2456 | (test-check "7.131" 2457 | (run* (q) 2458 | (-o '(0 0 0 1) '(1 0 1) q)) 2459 | `((1 1))) 2460 | 2461 | (test-check "7.132" 2462 | (run* (q) 2463 | (-o '(0 1 1) '(0 1 1) q)) 2464 | `(())) 2465 | 2466 | (test-check "7.133" 2467 | (run* (q) 2468 | (-o '(0 1 1) '(0 0 0 1) q)) 2469 | `()) 2470 | 2471 | ; 8.10 2472 | (define *o 2473 | (lambda (n m p) 2474 | (condi 2475 | ((== '() n) (== '() p)) 2476 | ((poso n) (== '() m) (== '() p)) 2477 | ((== '(1) n) (poso m) (== m p)) 2478 | ((>1o n) (== '(1) m) (== n p)) 2479 | ((fresh (x z) 2480 | (== `(0 . ,x) n) (poso x) 2481 | (== `(0 . ,z) p) (poso z) 2482 | (>1o m) 2483 | (*o x m z))) 2484 | ((fresh (x y) 2485 | (== `(1 . ,x) n) (poso x) 2486 | (== `(0 . ,y) m) (poso y) 2487 | (*o m n p))) 2488 | ((fresh (x y) 2489 | (== `(1 . ,x) n) (poso x) 2490 | (== `(1 . ,y) m) (poso y) 2491 | (odd-*o x n m p))) 2492 | (else fail)))) 2493 | 2494 | ; 8.18 2495 | (define odd-*o 2496 | (lambda (x n m p) 2497 | (fresh (q) 2498 | (bound-*o q p n m) 2499 | (*o x m q) 2500 | (+o `(0 . ,q) m p)))) 2501 | 2502 | (define bound-*o 2503 | (lambda (q p n m) 2504 | (conde 2505 | ((nullo q) (pairo p)) 2506 | (else 2507 | (fresh (x y z) 2508 | (cdro q x) 2509 | (cdro p y) 2510 | (condi 2511 | ((nullo n) 2512 | (cdro m z) 2513 | (bound-*o x y z '())) 2514 | (else 2515 | (cdro n z) 2516 | (bound-*o x y z m)))))))) 2517 | 2518 | (test-check "8.1" 2519 | (run 34 (t) 2520 | (fresh (x y r) 2521 | (*o x y r) 2522 | (== `(,x ,y ,r) t))) 2523 | `((() _.0 ()) 2524 | ((_.0 . _.1) () ()) 2525 | ((1) (_.0 . _.1) (_.0 . _.1)) 2526 | ((_.0 _.1 . _.2) (1) (_.0 _.1 . _.2)) 2527 | ((0 1) (_.0 _.1 . _.2) (0 _.0 _.1 . _.2)) 2528 | ((1 _.0 . _.1) (0 1) (0 1 _.0 . _.1)) 2529 | ((0 0 1) (_.0 _.1 . _.2) (0 0 _.0 _.1 . _.2)) 2530 | ((1 1) (1 1) (1 0 0 1)) 2531 | ((0 1 _.0 . _.1) (0 1) (0 0 1 _.0 . _.1)) 2532 | ((1 _.0 . _.1) (0 0 1) (0 0 1 _.0 . _.1)) 2533 | ((0 0 0 1) (_.0 _.1 . _.2) (0 0 0 _.0 _.1 . _.2)) 2534 | ((1 1) (1 0 1) (1 1 1 1)) 2535 | ((0 1 1) (1 1) (0 1 0 0 1)) 2536 | ((1 1) (0 1 1) (0 1 0 0 1)) 2537 | ((0 0 1 _.0 . _.1) (0 1) (0 0 0 1 _.0 . _.1)) 2538 | ((1 1) (1 1 1) (1 0 1 0 1)) 2539 | ((0 1 _.0 . _.1) (0 0 1) (0 0 0 1 _.0 . _.1)) 2540 | ((1 _.0 . _.1) (0 0 0 1) (0 0 0 1 _.0 . _.1)) 2541 | ((0 0 0 0 1) (_.0 _.1 . _.2) (0 0 0 0 _.0 _.1 . _.2)) 2542 | ((1 0 1) (1 1) (1 1 1 1)) 2543 | ((0 1 1) (1 0 1) (0 1 1 1 1)) 2544 | ((1 0 1) (0 1 1) (0 1 1 1 1)) 2545 | ((0 0 1 1) (1 1) (0 0 1 0 0 1)) 2546 | ((1 1) (1 0 0 1) (1 1 0 1 1)) 2547 | ((0 1 1) (0 1 1) (0 0 1 0 0 1)) 2548 | ((1 1) (0 0 1 1) (0 0 1 0 0 1)) 2549 | ((0 0 0 1 _.0 . _.1) (0 1) (0 0 0 0 1 _.0 . _.1)) 2550 | ((1 1) (1 1 0 1) (1 0 0 0 0 1)) 2551 | ((0 1 1) (1 1 1) (0 1 0 1 0 1)) 2552 | ((1 1 1) (0 1 1) (0 1 0 1 0 1)) 2553 | ((0 0 1 _.0 . _.1) (0 0 1) (0 0 0 0 1 _.0 . _.1)) 2554 | ((1 1) (1 0 1 1) (1 1 1 0 0 1)) 2555 | ((0 1 _.0 . _.1) (0 0 0 1) (0 0 0 0 1 _.0 . _.1)) 2556 | ((1 _.0 . _.1) (0 0 0 0 1) (0 0 0 0 1 _.0 . _.1)))) 2557 | 2558 | (test-check "8.4" 2559 | (run* (p) 2560 | (*o '(0 1) '(0 0 1) p)) 2561 | (list `(0 0 0 1))) 2562 | 2563 | ; 8.19 2564 | (define bound-*o 2565 | (lambda (q p n m) 2566 | succeed)) 2567 | 2568 | (test-check "8.20" 2569 | (run 1 (t) 2570 | (fresh (n m) 2571 | (*o n m '(1)) 2572 | (== `(,n ,m) t))) 2573 | (list `((1) (1)))) 2574 | 2575 | (test-divergence "8.21" 2576 | (run 2 (t) 2577 | (fresh (n m) 2578 | (*o n m '(1)) 2579 | (== `(,n ,m) t)))) 2580 | 2581 | ; 8.22 2582 | (define bound-*o 2583 | (lambda (q p n m) 2584 | (conde 2585 | ((nullo q) (pairo p)) 2586 | (else 2587 | (fresh (x y z) 2588 | (cdro q x) 2589 | (cdro p y) 2590 | (condi 2591 | ((nullo n) 2592 | (cdro m z) 2593 | (bound-*o x y z '())) 2594 | (else 2595 | (cdro n z) 2596 | (bound-*o x y z m)))))))) 2597 | 2598 | (test-check "8.23" 2599 | (run 2 (t) 2600 | (fresh (n m) 2601 | (*o n m '(1)) 2602 | (== `(,n ,m) t))) 2603 | `(((1) (1)))) 2604 | 2605 | (test-check "8.24" 2606 | (run* (p) 2607 | (*o '(1 1 1) '(1 1 1 1 1 1) p)) 2608 | (list `(1 0 0 1 1 1 0 1 1))) 2609 | 2610 | ; 8.26 2611 | (define =lo 2612 | (lambda (n m) 2613 | (conde 2614 | ((== '() n) (== '() m)) 2615 | ((== '(1) n) (== '(1) m)) 2616 | (else 2617 | (fresh (a x b y) 2618 | (== `(,a . ,x) n) (poso x) 2619 | (== `(,b . ,y) m) (poso y) 2620 | (=lo x y)))))) 2621 | 2622 | (test-check "8.27" 2623 | (run* (t) 2624 | (fresh (w x y) 2625 | (=lo `(1 ,w ,x . ,y) '(0 1 1 0 1)) 2626 | (== `(,w ,x ,y) t))) 2627 | (list `(_.0 _.1 (_.2 1)))) 2628 | 2629 | (test-check "8.28" 2630 | (run* (b) 2631 | (=lo '(1) `(,b))) 2632 | (list 1)) 2633 | 2634 | (test-check "8.29" 2635 | (run* (n) 2636 | (=lo `(1 0 1 . ,n) '(0 1 1 0 1))) 2637 | (list `(_.0 1))) 2638 | 2639 | (test-check "8.30" 2640 | (run 5 (t) 2641 | (fresh (y z) 2642 | (=lo `(1 . ,y) `(1 . ,z)) 2643 | (== `(,y ,z) t))) 2644 | `((() ()) 2645 | ((1) (1)) 2646 | ((_.0 1) (_.1 1)) 2647 | ((_.0 _.1 1) (_.2 _.3 1)) 2648 | ((_.0 _.1 _.2 1) (_.3 _.4 _.5 1)))) 2649 | 2650 | (test-check "8.31" 2651 | (run 5 (t) 2652 | (fresh (y z) 2653 | (=lo `(1 . ,y) `(0 . ,z)) 2654 | (== `(,y ,z) t))) 2655 | `(((1) (1)) 2656 | ((_.0 1) (_.1 1)) 2657 | ((_.0 _.1 1) (_.2 _.3 1)) 2658 | ((_.0 _.1 _.2 1) (_.3 _.4 _.5 1)) 2659 | ((_.0 _.1 _.2 _.3 1) (_.4 _.5 _.6 _.7 1)))) 2660 | 2661 | (test-check "8.33" 2662 | (run 5 (t) 2663 | (fresh (y z) 2664 | (=lo `(1 . ,y) `(0 1 1 0 1 . ,z)) 2665 | (== `(,y ,z) t))) 2666 | `(((_.0 _.1 _.2 1) ()) 2667 | ((_.0 _.1 _.2 _.3 1) (1)) 2668 | ((_.0 _.1 _.2 _.3 _.4 1) (_.5 1)) 2669 | ((_.0 _.1 _.2 _.3 _.4 _.5 1) (_.6 _.7 1)) 2670 | ((_.0 _.1 _.2 _.3 _.4 _.5 _.6 1) (_.7 _.8 _.9 1)))) 2671 | 2672 | ; 8.34 2673 | (define 1o m)) 2678 | (else 2679 | (fresh (a x b y) 2680 | (== `(,a . ,x) n) (poso x) 2681 | (== `(,b . ,y) m) (poso y) 2682 | (1o b) (=lo n b) (+o r b n)) 3021 | ((== '(1) b) (poso q) (+o r '(1) n)) 3022 | ((== '() b) (poso q) (== r n)) 3023 | ((== '(0 1) b) 3024 | (fresh (a ad dd) 3025 | (poso dd) 3026 | (== `(,a ,ad . ,dd) n) 3027 | (exp2 n '() q) 3028 | (fresh (s) 3029 | (splito n dd r s)))) 3030 | ((fresh (a ad add ddd) 3031 | (conde 3032 | ((== '(1 1) b)) 3033 | (else (== `(,a ,ad ,add . ,ddd) b)))) 3034 | (1o n) (== '(1) q) 3072 | (fresh (s) 3073 | (splito n b s '(1)))) 3074 | ((fresh (q1 b2) 3075 | (alli 3076 | (== `(0 . ,q1) q) 3077 | (poso q1) 3078 | (1o q) 3098 | (fresh (q1 nq1) 3099 | (+o q1 '(1) q) 3100 | (repeated-mul n q1 nq1) 3101 | (*o nq1 n nq))) 3102 | (else fail)))) 3103 | 3104 | (test-check "8.89" 3105 | (run* (r) 3106 | (logo '(0 1 1 1) '(0 1) '(1 1) r)) 3107 | (list `(0 1 1))) 3108 | 3109 | (cout "This next test takes several minutes to run!\n") 3110 | 3111 | (test-check "8.96" 3112 | (run 8 (s) 3113 | (fresh (b q r) 3114 | (logo '(0 0 1 0 0 0 1) b q r) 3115 | (>1o q) 3116 | (== `(,b ,q ,r) s))) 3117 | `(((1) (_.0 _.1 . _.2) (1 1 0 0 0 0 1)) 3118 | (() (_.0 _.1 . _.2) (0 0 1 0 0 0 1)) 3119 | ((0 1) (0 1 1) (0 0 1)) 3120 | ((0 0 1) (1 1) (0 0 1)) 3121 | ((1 0 1) (0 1) (1 1 0 1 0 1)) 3122 | ((0 1 1) (0 1) (0 0 0 0 0 1)) 3123 | ((1 1 1) (0 1) (1 1 0 0 1)) 3124 | ((0 0 0 1) (0 1) (0 0 1)))) 3125 | 3126 | ; 8.91 3127 | (define expo 3128 | (lambda (b q n) 3129 | (logo n b q '()))) 3130 | 3131 | (test-check "8.92" 3132 | (run* (t) 3133 | (expo '(1 1) '(1 0 1) t)) 3134 | (list `(1 1 0 0 1 1 1 1))) 3135 | 3136 | ; 9.6 3137 | (define u (var 'u)) 3138 | (define v (var 'v)) 3139 | (define w (var 'w)) 3140 | (define x (var 'x)) 3141 | (define y (var 'y)) 3142 | (define z (var 'z)) 3143 | 3144 | (test-check "9.8" 3145 | (rhs `(,z . b)) 3146 | 'b) 3147 | 3148 | (test-check "9.9" 3149 | (rhs `(,z . ,w)) 3150 | w) 3151 | 3152 | (test-check "9.10" 3153 | (rhs `(,z . (,x e ,y))) 3154 | `(,x e ,y)) 3155 | 3156 | (test-check "9.14" 3157 | (walk z `((,z . a) (,x . ,w) (,y . ,z))) 3158 | 'a) 3159 | 3160 | (test-check "9.15" 3161 | (walk y `((,z . a) (,x . ,w) (,y . ,z))) 3162 | 'a) 3163 | 3164 | (test-check "9.16" 3165 | (walk x `((,z . a) (,x . ,w) (,y . ,z))) 3166 | w) 3167 | 3168 | (test-check "9.17" 3169 | (walk w `((,z . a) (,x . ,w) (,y . ,z))) 3170 | w) 3171 | 3172 | (test-divergence "9.18" 3173 | (walk x `((,x . ,y) (,z . ,x) (,y . ,z)))) 3174 | 3175 | (test-check "9.19" 3176 | (walk w `((,x . ,y) (,w . b) (,z . ,x) (,y . ,z))) 3177 | 'b) 3178 | 3179 | (test-check "9.25" 3180 | (walk u `((,x . b) (,w . (,x e ,x)) (,u . ,w))) 3181 | `(,x e ,x)) 3182 | 3183 | (test-divergence "9.29" 3184 | (walk x (ext-s x y `((,z . ,x) (,y . ,z))))) 3185 | 3186 | (test-check "9.30" 3187 | (walk y `((,x . e))) 3188 | y) 3189 | 3190 | (test-check "9.31" 3191 | (walk y (ext-s y x `((,x . e)))) 3192 | 'e) 3193 | 3194 | (test-check "9.32" 3195 | (walk x `((,y . ,z) (,x . ,y))) 3196 | z) 3197 | 3198 | (test-check "9.33" 3199 | (walk x (ext-s z 'b `((,y . ,z) (,x . ,y)))) 3200 | 'b) 3201 | 3202 | (test-check "9.34" 3203 | (walk x (ext-s z w `((,y . ,z) (,x . ,y)))) 3204 | w) 3205 | 3206 | (test-check "9.44" 3207 | (walk* x `((,y . (a ,z c)) (,x . ,y) (,z . a))) 3208 | `(a a c)) 3209 | 3210 | (test-check "9.45" 3211 | (walk* x `((,y . (,z ,w c)) (,x . ,y) (,z . a))) 3212 | `(a ,w c)) 3213 | 3214 | (test-check "9.46" 3215 | (walk* y `((,y . (,w ,z c)) (,v . b) (,x . ,v) (,z . ,x))) 3216 | `(,w b c)) 3217 | 3218 | (test-check "9.47" 3219 | (run* (q) 3220 | (== #f q) 3221 | (project (q) 3222 | (== (not (not q)) q))) 3223 | '(#f)) 3224 | 3225 | (test-check "9.53" 3226 | (let ((r `(,w ,x ,y))) 3227 | (walk* r (reify-s r empty-s))) 3228 | `(_.0 _.1 _.2)) 3229 | 3230 | (test-check "9.54" 3231 | (let ((r (walk* `(,x ,y ,z) empty-s))) 3232 | (walk* r (reify-s r empty-s))) 3233 | `(_.0 _.1 _.2)) 3234 | 3235 | (test-check "9.55" 3236 | (let ((r `(,u (,v (,w ,x) ,y) ,x))) 3237 | (walk* r (reify-s r empty-s))) 3238 | `(_.0 (_.1 (_.2 _.3) _.4) _.3)) 3239 | 3240 | (test-check "9.56" 3241 | (let ((s `((,y . (,z ,w c ,w)) (,x . ,y) (,z . a)))) 3242 | (let ((r (walk* x s))) 3243 | (walk* r (reify-s r empty-s)))) 3244 | `(a _.0 c _.0)) 3245 | 3246 | (test-check "9.58" 3247 | (let ((s `((,y . (,z ,w c ,w)) (,x . ,y) (,z . a)))) 3248 | (reify (walk* x s))) 3249 | `(a _.0 c _.0)) 3250 | 3251 | (test-divergence "9.61" 3252 | (run 1 (x) 3253 | (== `(,x) x))) 3254 | 3255 | (test-check "9.62" 3256 | (run 1 (q) 3257 | (fresh (x) 3258 | (== `(,x) x) 3259 | (== #t q))) 3260 | `(#t)) 3261 | 3262 | (test-check "9.63" 3263 | (run 1 (q) 3264 | (fresh (x y) 3265 | (== `(,x) y) 3266 | (== `(,y) x) 3267 | (== #t q))) 3268 | `(#t)) 3269 | 3270 | (test-check "9.64" 3271 | (run 1 (x) 3272 | (==-check `(,x) x)) 3273 | `()) 3274 | 3275 | (test-divergence "9.65" 3276 | (run 1 (x) 3277 | (fresh (y z) 3278 | (== x z) 3279 | (== `(a b ,z) y) 3280 | (== x y)))) 3281 | 3282 | (test-check "9.66" 3283 | (run 1 (x) 3284 | (fresh (y z) 3285 | (== x z) 3286 | (== `(a b ,z) y) 3287 | (==-check x y))) 3288 | `()) 3289 | 3290 | (test-divergence "9.69" 3291 | (run 1 (x) 3292 | (== `(,x) x))) 3293 | 3294 | (test-check "10.1" 3295 | (run* (q) 3296 | (conda 3297 | (fail succeed) 3298 | (else fail))) 3299 | '()) 3300 | 3301 | (test-check "10.2" 3302 | (not (null? (run* (q) 3303 | (conda 3304 | (fail succeed) 3305 | (else succeed))))) 3306 | #t) 3307 | 3308 | (test-check "10.3" 3309 | (not (null? (run* (q) 3310 | (conda 3311 | (succeed fail) 3312 | (else succeed))))) 3313 | #f) 3314 | 3315 | (test-check "10.4" 3316 | (not (null? (run* (q) 3317 | (conda 3318 | (succeed succeed) 3319 | (else fail))))) 3320 | #t) 3321 | 3322 | (test-check "10.5" 3323 | (run* (x) 3324 | (conda 3325 | ((== 'olive x) succeed) 3326 | ((== 'oil x) succeed) 3327 | (else fail))) 3328 | `(olive)) 3329 | 3330 | (test-check "10.7" 3331 | (run* (x) 3332 | (conda 3333 | ((== 'virgin x) fail) 3334 | ((== 'olive x) succeed) 3335 | ((== 'oil x) succeed) 3336 | (else fail))) 3337 | `()) 3338 | 3339 | (test-check "10.8" 3340 | (run* (q) 3341 | (fresh (x y) 3342 | (== 'split x) 3343 | (== 'pea y) 3344 | (conda 3345 | ((== 'split x) (== x y)) 3346 | (else succeed))) 3347 | (== #t q)) 3348 | `()) 3349 | 3350 | (test-check "10.9" 3351 | (run* (q) 3352 | (fresh (x y) 3353 | (== 'split x) 3354 | (== 'pea y) 3355 | (conda 3356 | ((== x y) (== 'split x)) 3357 | (else succeed))) 3358 | (== #t q)) 3359 | (list #t)) 3360 | 3361 | ; 10.11.1 3362 | (define not-pastao 3363 | (lambda (x) 3364 | (conda 3365 | ((== 'pasta x) fail) 3366 | (else succeed)))) 3367 | 3368 | (test-check "10.11.2" 3369 | (run* (x) 3370 | (conda 3371 | ((not-pastao x) fail) 3372 | (else (== 'spaghetti x)))) 3373 | '(spaghetti)) 3374 | 3375 | (test-check "10.12" 3376 | (run* (x) 3377 | (== 'spaghetti x) 3378 | (conda 3379 | ((not-pastao x) fail) 3380 | (else (== 'spaghetti x)))) 3381 | '()) 3382 | 3383 | (test-divergence "10.13" 3384 | (run* (q) 3385 | (conda 3386 | (alwayso succeed) 3387 | (else fail)) 3388 | (== #t q))) 3389 | 3390 | (test-check "10.14" 3391 | (run* (q) 3392 | (condu 3393 | (alwayso succeed) 3394 | (else fail)) 3395 | (== #t q)) 3396 | `(#t)) 3397 | 3398 | (test-divergence "10.15" 3399 | (run* (q) 3400 | (condu 3401 | (succeed alwayso) 3402 | (else fail)) 3403 | (== #t q))) 3404 | 3405 | (test-divergence "10.17" 3406 | (run 1 (q) 3407 | (conda 3408 | (alwayso succeed) 3409 | (else fail)) 3410 | fail 3411 | (== #t q))) 3412 | 3413 | (test-check "10.18" 3414 | (run 1 (q) 3415 | (condu 3416 | (alwayso succeed) 3417 | (else fail)) 3418 | fail 3419 | (== #t q)) 3420 | `()) 3421 | 3422 | ; 10.19.1 3423 | (define onceo 3424 | (lambda (g) 3425 | (condu 3426 | (g succeed) 3427 | (else fail)))) 3428 | 3429 | (test-check "10.19.2" 3430 | (run* (x) 3431 | (onceo (teacupo x))) 3432 | `(tea)) 3433 | 3434 | (test-check "10.20" 3435 | (run 1 (q) 3436 | (onceo (salo nevero)) 3437 | fail) 3438 | `()) 3439 | 3440 | (test-check "10.21" 3441 | (run* (r) 3442 | (conde 3443 | ((teacupo r) succeed) 3444 | ((== #f r) succeed) 3445 | (else fail))) 3446 | `(tea cup #f)) 3447 | 3448 | (test-check "10.22" 3449 | (run* (r) 3450 | (conda 3451 | ((teacupo r) succeed) 3452 | ((== #f r) succeed) 3453 | (else fail))) 3454 | `(tea cup)) 3455 | 3456 | (test-check "10.23" 3457 | (run* (r) 3458 | (== #f r) 3459 | (conda 3460 | ((teacupo r) succeed) 3461 | ((== #f r) succeed) 3462 | (else fail))) 3463 | `(#f)) 3464 | 3465 | (test-check "10.24" 3466 | (run* (r) 3467 | (== #f r) 3468 | (condu 3469 | ((teacupo r) succeed) 3470 | ((== #f r) succeed) 3471 | (else fail))) 3472 | `(#f)) 3473 | 3474 | ; 10.26.1 3475 | (define bumpo 3476 | (lambda (n x) 3477 | (conde 3478 | ((== n x) succeed) 3479 | (else 3480 | (fresh (m) 3481 | (-o n '(1) m) 3482 | (bumpo m x)))))) 3483 | 3484 | (test-check "10.26.2" 3485 | (run* (x) 3486 | (bumpo '(1 1 1) x)) 3487 | `((1 1 1) 3488 | (0 1 1) 3489 | (1 0 1) 3490 | (0 0 1) 3491 | (1 1) 3492 | (0 1) 3493 | (1) 3494 | ())) 3495 | 3496 | ; 10.27.1 3497 | (define gen&testo 3498 | (lambda (op i j k) 3499 | (onceo 3500 | (fresh (x y z) 3501 | (op x y z) 3502 | (== i x) 3503 | (== j y) 3504 | (== k z))))) 3505 | 3506 | (test-check "10.27.2" 3507 | (run* (q) 3508 | (gen&testo +o '(0 0 1) '(1 1) '(1 1 1)) 3509 | (== #t q)) 3510 | (list #t)) 3511 | 3512 | (test-divergence "10.42" 3513 | (run 1 (q) 3514 | (gen&testo +o '(0 0 1) '(1 1) '(0 1 1)))) 3515 | 3516 | ; 10.43.1 3517 | (define enumerateo 3518 | (lambda (op r n) 3519 | (fresh (i j k) 3520 | (bumpo n i) 3521 | (bumpo n j) 3522 | (op i j k) 3523 | (gen&testo op i j k) 3524 | (== `(,i ,j ,k) r)))) 3525 | 3526 | (test-check "10.43.2" 3527 | (run* (s) 3528 | (enumerateo +o s '(1 1))) 3529 | `(((1 1) (1 1) (0 1 1)) 3530 | ((1 1) (0 1) (1 0 1)) 3531 | ((1 1) (1) (0 0 1)) 3532 | ((1 1) () (1 1)) 3533 | ((0 1) (1 1) (1 0 1)) 3534 | ((0 1) (0 1) (0 0 1)) 3535 | ((0 1) (1) (1 1)) 3536 | ((0 1) () (0 1)) 3537 | ((1) (1 1) (0 0 1)) 3538 | ((1) (0 1) (1 1)) 3539 | ((1) (1) (0 1)) 3540 | ((1) () (1)) 3541 | (() (1 1) (1 1)) 3542 | (() (0 1) (0 1)) 3543 | (() (1) (1)) 3544 | (() () ()))) 3545 | 3546 | (test-check "10.56" 3547 | (run 1 (s) 3548 | (enumerateo +o s '(1 1 1))) 3549 | `(((1 1 1) (1 1 1) (0 1 1 1)))) 3550 | 3551 | ; 10.57 3552 | (define gen-addero 3553 | (lambda (d n m r) 3554 | (fresh (a b c e x y z) 3555 | (== `(,a . ,x) n) 3556 | (== `(,b . ,y) m) (poso y) 3557 | (== `(,c . ,z) r) (poso z) 3558 | (all 3559 | (full-addero d a b c e) 3560 | (addero e x y z))))) 3561 | 3562 | (test-divergence "10.58" 3563 | (run 1 (q) 3564 | (gen&testo +o '(0 1) '(1 1) '(1 0 1)))) 3565 | 3566 | (test-divergence "10.62" 3567 | (run* (q) 3568 | (enumerateo +o q '(1 1 1)))) 3569 | -------------------------------------------------------------------------------- /pkg-list.scm: -------------------------------------------------------------------------------- 1 | (package (minikanren (0 1)) 2 | (synopsis "A relational programming extension to Scheme") 3 | (description 4 | "An R6RS packaged version of the MiniKanren logic programming" 5 | "system, originally written by Friedman Byrd and Kiselyov, and" 6 | "featured in the book, \"The Reasoned Schemer\".") 7 | (homepage "http://github.com/ijp/minikanren/") 8 | (libraries 9 | "minikanren.scm" 10 | "minikanren") 11 | (documentation 12 | "README.org" 13 | "COPYING")) 14 | --------------------------------------------------------------------------------