├── ==-tests.scm ├── LICENSE ├── README.md ├── absento-closure-tests.scm ├── absento-tests.scm ├── disequality-tests.scm ├── matche.rkt ├── matche.scm ├── mk-chicken.scm ├── mk-guile.scm ├── mk.rkt ├── mk.scm ├── numbero-tests.scm ├── numbers.scm ├── symbolo-numbero-tests.scm ├── symbolo-tests.scm ├── test-all.scm ├── test-check.scm ├── test-infer.scm ├── test-interp.scm ├── test-numbers.scm └── test-quines.scm /==-tests.scm: -------------------------------------------------------------------------------- 1 | (test "1" 2 | (run 1 (q) (== 5 q)) 3 | '(5)) 4 | 5 | (test "2" 6 | (run* (q) 7 | (conde 8 | [(== 5 q)] 9 | [(== 6 q)])) 10 | '(5 6)) 11 | 12 | (test "3" 13 | (run* (q) 14 | (fresh (a d) 15 | (conde 16 | [(== 5 a)] 17 | [(== 6 d)]) 18 | (== `(,a . ,d) q))) 19 | '((5 . _.0) (_.0 . 6))) 20 | 21 | (define appendo 22 | (lambda (l s out) 23 | (conde 24 | [(== '() l) (== s out)] 25 | [(fresh (a d res) 26 | (== `(,a . ,d) l) 27 | (== `(,a . ,res) out) 28 | (appendo d s res))]))) 29 | 30 | (test "4" 31 | (run* (q) (appendo '(a b c) '(d e) q)) 32 | '((a b c d e))) 33 | 34 | (test "5" 35 | (run* (q) (appendo q '(d e) '(a b c d e))) 36 | '((a b c))) 37 | 38 | (test "6" 39 | (run* (q) (appendo '(a b c) q '(a b c d e))) 40 | '((d e))) 41 | 42 | (test "7" 43 | (run 5 (q) 44 | (fresh (l s out) 45 | (appendo l s out) 46 | (== `(,l ,s ,out) q))) 47 | '((() _.0 _.0) 48 | ((_.0) _.1 (_.0 . _.1)) 49 | ((_.0 _.1) _.2 (_.0 _.1 . _.2)) 50 | ((_.0 _.1 _.2) _.3 (_.0 _.1 _.2 . _.3)) 51 | ((_.0 _.1 _.2 _.3) _.4 (_.0 _.1 _.2 _.3 . _.4)))) 52 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 William E. Byrd 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # miniKanren-with-symbolic-constraints 2 | 3 | The version of miniKanren I normally use. Includes `==`, `=/=`, `symbolo`, `numbero`, generalized `absento` constraints. 4 | 5 | Good for writing Quine-generating interpreters, etc. :) 6 | 7 | Also includes `eigen`, which represents universally quanitifed variables. Beware: this implementation does *not* support use of `eigen` with constraints other than `==`. 8 | 9 | Also includes multi-query variable version of `run`. 10 | For example, `(run (q r s) (== (cons r q) s))`. 11 | 12 | ## Running 13 | 14 | ### Chez and Vicare 15 | 16 | ``` 17 | (load "mk.scm") 18 | ``` 19 | 20 | ### Racket 21 | 22 | ``` 23 | (require "mk.rkt") 24 | ``` 25 | 26 | ### Guile 27 | 28 | ``` 29 | (load "mk-guile.scm") 30 | ``` 31 | 32 | ### Chicken 33 | 34 | ``` 35 | (load "mk-chicken.scm") 36 | ``` 37 | 38 | ## Running Tests 39 | 40 | After loading miniKanren as above, 41 | 42 | ``` 43 | (load "test-all.scm") 44 | ``` 45 | 46 | regardless of scheme implementation. 47 | -------------------------------------------------------------------------------- /absento-closure-tests.scm: -------------------------------------------------------------------------------- 1 | (test "absento 'closure-1a" 2 | (run* (q) (absento 'closure q) (== q 'closure)) 3 | '()) 4 | 5 | (test "absento 'closure-1b" 6 | (run* (q) (== q 'closure) (absento 'closure q)) 7 | '()) 8 | 9 | (test "absento 'closure-2a" 10 | (run* (q) (fresh (a d) (== q 'closure) (absento 'closure q))) 11 | '()) 12 | 13 | (test "absento 'closure-2b" 14 | (run* (q) (fresh (a d) (absento 'closure q) (== q 'closure))) 15 | '()) 16 | 17 | (test "absento 'closure-3a" 18 | (run* (q) (fresh (a d) (absento 'closure q) (== `(,a . ,d) q))) 19 | '(((_.0 . _.1) (absento (closure _.0) (closure _.1))))) 20 | 21 | (test "absento 'closure-3b" 22 | (run* (q) (fresh (a d) (== `(,a . ,d) q) (absento 'closure q))) 23 | '(((_.0 . _.1) (absento (closure _.0) (closure _.1))))) 24 | 25 | (test "absento 'closure-4a" 26 | (run* (q) (fresh (a d) (absento 'closure q) (== `(,a . ,d) q) (== 'closure a))) 27 | '()) 28 | 29 | (test "absento 'closure-4b" 30 | (run* (q) (fresh (a d) (absento 'closure q) (== 'closure a) (== `(,a . ,d) q))) 31 | '()) 32 | 33 | (test "absento 'closure-4c" 34 | (run* (q) (fresh (a d) (== 'closure a) (absento 'closure q) (== `(,a . ,d) q))) 35 | '()) 36 | 37 | (test "absento 'closure-4d" 38 | (run* (q) (fresh (a d) (== 'closure a) (== `(,a . ,d) q) (absento 'closure q))) 39 | '()) 40 | 41 | (test "absento 'closure-5a" 42 | (run* (q) (fresh (a d) (absento 'closure q) (== `(,a . ,d) q) (== 'closure d))) 43 | '()) 44 | 45 | (test "absento 'closure-5b" 46 | (run* (q) (fresh (a d) (absento 'closure q) (== 'closure d) (== `(,a . ,d) q))) 47 | '()) 48 | 49 | (test "absento 'closure-5c" 50 | (run* (q) (fresh (a d) (== 'closure d) (absento 'closure q) (== `(,a . ,d) q))) 51 | '()) 52 | 53 | (test "absento 'closure-5d" 54 | (run* (q) (fresh (a d) (== 'closure d) (== `(,a . ,d) q) (absento 'closure q))) 55 | '()) 56 | 57 | (test "absento 'closure-6" 58 | (run* (q) 59 | (== `(3 (closure x (x x) ((y . 7))) #t) q) 60 | (absento 'closure q)) 61 | '()) 62 | -------------------------------------------------------------------------------- /absento-tests.scm: -------------------------------------------------------------------------------- 1 | (test "test 0" 2 | (run* (q) (absento q q)) 3 | '()) 4 | 5 | (test "test 1" 6 | (run* (q) 7 | (fresh (a b c) 8 | (== a b) 9 | (absento b c) 10 | (== c b) 11 | (== `(,a ,b ,c) q))) 12 | '()) 13 | 14 | (test "test 2" 15 | (run* (q) 16 | (fresh (a) 17 | (absento q a) 18 | (absento `((,q ,q) 3 (,q ,q)) `(,a 3 ,a)))) 19 | '(_.0)) 20 | 21 | (test "test 3" 22 | (run* (q) 23 | (fresh (a b) 24 | (absento q a) 25 | (absento `(3 ,a) `(,b ,a)) 26 | (== 3 b))) 27 | '()) 28 | 29 | (test "test 4" 30 | (run* (q) 31 | (fresh (a b) 32 | (absento q a) 33 | (absento `(3 ,a) `(,q ,a)) 34 | (== 3 b))) 35 | '((_.0 (=/= ((_.0 3)))))) 36 | 37 | (test "test 5" 38 | (run* (q) 39 | (fresh (a b) 40 | (numbero a) 41 | (numbero b) 42 | (absento '(3 3) `(,a ,b)) 43 | (=/= a b) 44 | (== `(,a ,b) q))) 45 | '(((_.0 _.1) (=/= ((_.0 _.1))) (num _.0 _.1)))) 46 | 47 | (test "test 6" 48 | (run* (q) (fresh (a) (absento q a) (== q a))) 49 | '()) 50 | 51 | (test "test 7" 52 | (run* (q) 53 | (fresh (a b c) 54 | (absento '(3 . 4) c) 55 | (== `(,a . ,b) c) 56 | (== q `(,a . ,b)))) 57 | '(((_.0 . _.1) (=/= ((_.0 3) (_.1 4))) (absento ((3 . 4) _.0) ((3 . 4) _.1))))) 58 | 59 | (test "test 8" 60 | (run* (q) 61 | (fresh (a b) 62 | (absento 5 a) 63 | (symbolo b) 64 | (== `(,q ,b) a))) 65 | '((_.0 (absento (5 _.0))))) 66 | 67 | (test "test 9" 68 | (run* (q) 69 | (fresh (a b) 70 | (absento 5 a) 71 | (== `(,q ,b) a))) 72 | '((_.0 (absento (5 _.0))))) 73 | 74 | (test "test 10" 75 | (run* (q) (fresh (a) (absento `(3 . ,a) q) (absento q `(3 . ,a)))) 76 | '((_.0 (=/= ((_.0 3)))))) 77 | 78 | (test "test 11" 79 | (run* (q) 80 | (fresh (a b c d e f) 81 | (absento `(,a . ,b) q) 82 | (absento q `(,a . ,b)) 83 | (== `(,c . ,d) a) 84 | (== `(3 . ,e) c) 85 | (== `(,f . 4) d))) 86 | '((_.0 (=/= ((_.0 3)) ((_.0 4)))))) 87 | 88 | (test "test 12" 89 | (run* (q) 90 | (fresh (a b c) 91 | (absento `(,3 . ,a) `(,b . ,c)) 92 | (numbero b) 93 | (== `(,a ,b ,c) q))) 94 | '(((_.0 _.1 _.2) (=/= ((_.0 _.2) (_.1 3))) (num _.1) (absento ((3 . _.0) _.2))))) 95 | 96 | (test "test 13" 97 | (run* (q) 98 | (fresh (a b c) 99 | (== `(,a . ,b) q) 100 | (absento '(3 . 4) q) 101 | (numbero a) 102 | (numbero b))) 103 | '(((_.0 . _.1) (=/= ((_.0 3) (_.1 4))) (num _.0 _.1)))) 104 | 105 | (test "test 14" 106 | (run* (q) 107 | (fresh (a b) 108 | (absento '(3 . 4) `(,a . ,b)) 109 | (== `(,a . ,b) q))) 110 | '(((_.0 . _.1) (=/= ((_.0 3) (_.1 4))) (absento ((3 . 4) _.0) ((3 . 4) _.1))))) 111 | 112 | (test "test 15" 113 | (run* (q) 114 | (absento q `(3 . (4 . 5)))) 115 | '((_.0 (=/= ((_.0 3)) 116 | ((_.0 4)) 117 | ((_.0 5)) 118 | ((_.0 (3 . (4 . 5)))) 119 | ((_.0 (4 . 5))))))) 120 | 121 | (test "test 16" 122 | (run* (q) 123 | (fresh (a b x) 124 | (absento a b) 125 | (symbolo a) 126 | (numbero x) 127 | (== x b) 128 | (== `(,a ,b) q))) 129 | '(((_.0 _.1) (num _.1) (sym _.0)))) 130 | 131 | (test "test 19" 132 | (run* (q) (absento 5 q) (absento 5 q)) 133 | '((_.0 (absento (5 _.0))))) 134 | 135 | (test "test 20" 136 | (run* (q) (absento 5 q) (absento 6 q)) 137 | '((_.0 (absento (5 _.0) (6 _.0))))) 138 | 139 | (test "test 21" 140 | (run* (q) (absento 5 q) (symbolo q)) 141 | '((_.0 (sym _.0)))) 142 | 143 | (test "test 22" 144 | (run* (q) (numbero q) (absento 'tag q)) 145 | '((_.0 (num _.0)))) 146 | 147 | (test "test 23" 148 | (run* (q) (absento 'tag q) (numbero q)) 149 | '((_.0 (num _.0)))) 150 | 151 | (test "test 24" 152 | (run* (q) (== 5 q) (absento 5 q)) 153 | '()) 154 | 155 | (test "test 25" 156 | (run* (q) (== q `(5 6)) (absento 5 q)) 157 | '()) 158 | 159 | (test "test 25b" 160 | (run* (q) (absento 5 q) (== q `(5 6))) 161 | '()) 162 | 163 | (test "test 26" 164 | (run* (q) (absento 5 q) (== 5 q)) 165 | '()) 166 | 167 | (test "test 27" 168 | (run* (q) (absento 'tag1 q) (absento 'tag2 q)) 169 | '((_.0 (absento (tag1 _.0) (tag2 _.0))))) 170 | 171 | (test "test 28" 172 | (run* (q) (absento 'tag q) (numbero q)) 173 | '((_.0 (num _.0)))) 174 | 175 | (test "test 29" 176 | (run* (q) 177 | (fresh (a b) 178 | (absento a b) 179 | (absento b a) 180 | (== `(,a ,b) q) 181 | (symbolo a) 182 | (numbero b))) 183 | '(((_.0 _.1) (num _.1) (sym _.0)))) 184 | 185 | (test "test 30" 186 | (run* (q) 187 | (fresh (a b) 188 | (absento b a) 189 | (absento a b) 190 | (== `(,a ,b) q) 191 | (symbolo a) 192 | (symbolo b))) 193 | '(((_.0 _.1) (=/= ((_.0 _.1))) (sym _.0 _.1)))) 194 | 195 | (test "test 31" 196 | (run* (q) 197 | (fresh (a b) 198 | (absento a b) 199 | (absento b a) 200 | (== `(,a ,b) q))) 201 | '(((_.0 _.1) (absento (_.0 _.1) (_.1 _.0))))) 202 | 203 | (test "test 32" 204 | (run* (q) 205 | (fresh (a b) 206 | (absento 5 a) 207 | (absento 5 b) 208 | (== `(,a . ,b) q))) 209 | '(((_.0 . _.1) (absento (5 _.0) (5 _.1))))) 210 | 211 | (test "test 33" 212 | (run* (q) 213 | (fresh (a b c) 214 | (== `(,a ,b) c) 215 | (== `(,c ,c) q) 216 | (symbolo b) 217 | (numbero c))) 218 | '()) 219 | 220 | (test "test 34" 221 | (run* (q) (absento 'tag q) (symbolo q)) 222 | '((_.0 (=/= ((_.0 tag))) (sym _.0)))) 223 | 224 | (test "test 35" 225 | (run* (q) (absento 5 q) (numbero q)) 226 | '((_.0 (=/= ((_.0 5))) (num _.0)))) 227 | 228 | (test "test 36" 229 | (run* (q) 230 | (fresh (a) 231 | (== 5 a) (absento a q))) 232 | '((_.0 (absento (5 _.0))))) 233 | 234 | (test "test 37" 235 | (run* (q) 236 | (fresh (a b) 237 | (absento a b) 238 | (absento b a) 239 | (== `(,a ,b) q) 240 | (symbolo a) 241 | (symbolo b))) 242 | '(((_.0 _.1) (=/= ((_.0 _.1))) (sym _.0 _.1)))) 243 | 244 | (test "test 38" 245 | (run* (q) (absento '() q)) 246 | '((_.0 (absento (() _.0))))) 247 | 248 | (test "test 39" 249 | (run* (q) (absento `(3 4) q)) 250 | '((_.0 (absento ((3 4) _.0))))) 251 | 252 | (test "test 40" 253 | (run* (q) 254 | (fresh (d a c) 255 | (== `(3 . ,d) q) 256 | (=/= `(,c . ,a) q) 257 | (== '(3 . 4) d))) 258 | '((3 3 . 4))) 259 | 260 | (test "test 41" 261 | (run* (q) 262 | (fresh (a) 263 | (== `(,a . ,a) q))) 264 | '((_.0 . _.0))) 265 | 266 | (test "test 42" 267 | (run* (q) 268 | (fresh (a b) 269 | (== `((3 4) (5 6)) q) 270 | (absento `(3 4) q))) 271 | '()) 272 | 273 | (test "test 43" 274 | (run* (q) (absento q 3)) 275 | '((_.0 (=/= ((_.0 3)))))) 276 | 277 | (test "test 44" 278 | (run* (q) 279 | (fresh (a b) 280 | (absento a b) 281 | (absento b a) 282 | (== `(,a ,b) q))) 283 | '(((_.0 _.1) (absento (_.0 _.1) (_.1 _.0))))) 284 | 285 | (test "test 45" 286 | (run* (q) 287 | (fresh (a b) 288 | (absento `(,a . ,b) q) 289 | (== q `(3 . (,b . ,b))))) 290 | '((3 _.0 . _.0))) 291 | 292 | (test "test 45b" 293 | (run* (q) 294 | (fresh (a b) 295 | (absento `(,a . ,b) q) 296 | (== q `(,a 3 . (,b . ,b))))) 297 | '(((_.0 3 _.1 . _.1) (=/= ((_.0 _.1)))))) 298 | 299 | (test "test 46" 300 | (run* (q) 301 | (fresh (a) 302 | (absento a q) 303 | (absento q a))) 304 | '(_.0)) 305 | 306 | (test "test 47" 307 | (run* (q) 308 | (fresh (a) 309 | (absento `(,a . 3) q))) 310 | '(_.0)) 311 | 312 | (test "test 48" 313 | (run* (q) 314 | (fresh (a) 315 | (absento `(,a . 3) q))) 316 | '(_.0)) 317 | 318 | (test "test 49" 319 | (run* (q) 320 | (fresh (a b c d e) 321 | (absento `((3 4 ,a) (4 ,b) ((,c)) ,d ,e) q))) 322 | '(_.0)) 323 | 324 | (test "test 50" 325 | (run* (q) 326 | (fresh (a) 327 | (absento a q) 328 | (== 5 a))) 329 | '((_.0 (absento (5 _.0))))) 330 | 331 | (test "test 51" 332 | (run* (q) 333 | (fresh (a b c d) 334 | (== a 5) 335 | (== a b) 336 | (== b c) 337 | (absento d q) 338 | (== c d))) 339 | '((_.0 (absento (5 _.0))))) 340 | 341 | (test "test 52" 342 | (run* (q) 343 | (fresh (a b c d) 344 | (== a b) 345 | (== b c) 346 | (absento a q) 347 | (== c d) 348 | (== d 5))) 349 | '((_.0 (absento (5 _.0))))) 350 | 351 | (test "test 53" 352 | (run* (q) 353 | (fresh (t1 t2 a) 354 | (== `(,a . 3) t1) 355 | (== `(,a . (4 . 3)) t2) 356 | (== `(,t1 ,t2) q) 357 | (absento t1 t2))) 358 | '((((_.0 . 3) (_.0 4 . 3)) (=/= ((_.0 4)))))) 359 | 360 | (test "test 54" 361 | (run* (q) 362 | (fresh (a) 363 | (== `(,a . 3) q) 364 | (absento q `(,a . (4 . 3))))) 365 | '(((_.0 . 3) (=/= ((_.0 4)))))) 366 | 367 | (test "test 55" 368 | (run* (q) 369 | (fresh (a d c) 370 | (== '(3 . 4) d) 371 | (absento `(3 . 4) q) 372 | (== `(3 . ,d) q))) 373 | '()) 374 | 375 | (test "test 56" 376 | (run* (q) 377 | (fresh (a b) 378 | (absento a b) 379 | (absento b a) 380 | (== `(,a ,b) q) 381 | (symbolo a) 382 | (numbero b))) 383 | '(((_.0 _.1) (num _.1) (sym _.0)))) 384 | 385 | 386 | (test "test 57" 387 | (run* (q) 388 | (numbero q) 389 | (absento q 3)) 390 | '((_.0 (=/= ((_.0 3))) (num _.0)))) 391 | 392 | (test "test 58" 393 | (run* (q) 394 | (fresh (a) 395 | (== `(,a . 3) q) 396 | (absento q `(,a . (4 . (,a . 3)))))) 397 | '()) 398 | 399 | (test "test 59" 400 | (run* (q) 401 | (fresh (a) 402 | (== `(,a . 3) q) 403 | (absento q `(,a . ((,a . 3) . (,a . 4)))))) 404 | '()) 405 | 406 | (test "test 60" 407 | (run* (q) 408 | (fresh (a d c) 409 | (== `(3 . ,d) q) 410 | (== '(3 . 4) d) 411 | (absento `(3 . 4) q))) 412 | '()) 413 | 414 | (test "test 61" 415 | (run* (q) 416 | (fresh (a b c) 417 | (symbolo b) 418 | (absento `(,3 . ,a) `(,b . ,c)) 419 | (== `(,a ,b ,c) q))) 420 | '(((_.0 _.1 _.2) (sym _.1) (absento ((3 . _.0) _.2))))) 421 | 422 | (test "test 62" 423 | (run* (q) (fresh (a b c) (absento a b) (absento b c) (absento c q) (symbolo a))) 424 | '(_.0)) 425 | 426 | (test "test 63" 427 | (run* (q) (fresh (a b c) (=/= a b) (=/= b c) (=/= c q) (symbolo a))) 428 | '(_.0)) 429 | 430 | (test "test 64" 431 | (run* (q) (symbolo q) (== 'tag q)) 432 | '(tag)) 433 | 434 | (test "test 65" 435 | (run* (q) (fresh (b) (absento '(3 4) `(,q ,b)))) 436 | '((_.0 (absento ((3 4) _.0))))) 437 | 438 | (test "test 66" 439 | (run* (q) (absento 6 5)) 440 | '(_.0)) 441 | 442 | (test "test 67" 443 | (run* (q) 444 | (fresh (a b) 445 | (=/= a b) 446 | (symbolo a) 447 | (numbero b) 448 | (== `(,a ,b) q))) 449 | '(((_.0 _.1) (num _.1) (sym _.0)))) 450 | 451 | (test "test 68" 452 | (run* (q) 453 | (fresh (a b c d) 454 | (=/= `(,a ,b) `(,c ,d)) 455 | (symbolo a) 456 | (numbero c) 457 | (symbolo b) 458 | (numbero c) 459 | (== `(,a ,b ,c ,d) q))) 460 | '(((_.0 _.1 _.2 _.3) (num _.2) (sym _.0 _.1)))) 461 | 462 | (test "test 69" 463 | (run* (q) 464 | (fresh (a b) 465 | (=/= `(,a . 3) `(,b . 3)) 466 | (symbolo a) 467 | (numbero b) 468 | (== `(,a ,b) q))) 469 | '(((_.0 _.1) (num _.1) (sym _.0)))) 470 | 471 | (test "test 70" 472 | (run* (q) 473 | (fresh (a b) 474 | (absento a b) 475 | (absento b a) 476 | (== `(,a ,b) q) 477 | (symbolo a) 478 | (numbero b))) 479 | '(((_.0 _.1) (num _.1) (sym _.0)))) 480 | 481 | (test "test 70b" 482 | (run* (q) 483 | (fresh (a b) 484 | (symbolo a) 485 | (numbero b) 486 | (absento a b) 487 | (absento b a) 488 | (== `(,a ,b) q))) 489 | '(((_.0 _.1) (num _.1) (sym _.0)))) 490 | 491 | (test "test 71" 492 | (run* (q) 493 | (fresh (a b) 494 | (absento a b) 495 | (absento b a) 496 | (== `(,a ,b) q) 497 | (symbolo a) 498 | (symbolo b))) 499 | '(((_.0 _.1) (=/= ((_.0 _.1))) (sym _.0 _.1)))) 500 | 501 | (test "test 72" 502 | (run* (q) 503 | (fresh (a b) 504 | (absento a b) 505 | (absento b a) 506 | (== `(,a ,b) q))) 507 | '(((_.0 _.1) (absento (_.0 _.1) (_.1 _.0))))) 508 | 509 | (test "test 73" 510 | (run* (q) 511 | (fresh (a b) 512 | (== `(,a ,b) q) 513 | (absento b a) 514 | (absento a b) 515 | (== a '(1 . 2)))) 516 | '((((1 . 2) _.0) 517 | (=/= ((_.0 1)) ((_.0 2))) 518 | (absento ((1 . 2) _.0))))) 519 | 520 | (test "test 74" 521 | (run* (q) 522 | (fresh (a b c) 523 | (absento a q) 524 | (absento q a) 525 | (== `(,b . ,c) a) 526 | (== '(1 . 2) b) 527 | (== '(3 . 4) c))) 528 | '((_.0 (=/= ((_.0 1)) ((_.0 2)) ((_.0 3)) ((_.0 4)) 529 | ((_.0 (1 . 2))) ((_.0 (3 . 4)))) 530 | (absento (((1 . 2) 3 . 4) _.0))))) 531 | 532 | (test "test 75" 533 | (run* (q) 534 | (fresh (a b c d e f g) 535 | (absento a q) 536 | (absento q a) 537 | (== `(,b . ,c) a) 538 | (== `(,d . ,e) b) 539 | (== `(,f . ,g) c) 540 | (== '(1 . 2) d) 541 | (== '(3 . 4) e) 542 | (== '(5 . 6) f) 543 | (== '(7 . 8) g))) 544 | '((_.0 (=/= ((_.0 ((1 . 2) 3 . 4))) 545 | ((_.0 ((5 . 6) 7 . 8))) 546 | ((_.0 1)) 547 | ((_.0 2)) 548 | ((_.0 3)) 549 | ((_.0 4)) 550 | ((_.0 5)) 551 | ((_.0 6)) 552 | ((_.0 7)) 553 | ((_.0 8)) 554 | ((_.0 (1 . 2))) 555 | ((_.0 (3 . 4))) 556 | ((_.0 (5 . 6))) 557 | ((_.0 (7 . 8)))) 558 | (absento ((((1 . 2) 3 . 4) (5 . 6) 7 . 8) _.0))))) 559 | 560 | (test "test 76" 561 | (run* (q) 562 | (absento 3 q) 563 | (absento '(3 4) q)) 564 | '((_.0 (absento (3 _.0))))) 565 | 566 | (test "test 77" 567 | (run* (q) 568 | (fresh (x a b) 569 | (== x `(,a ,b)) 570 | (absento '(3 4) x) 571 | (absento 3 a) 572 | (absento 4 b) 573 | (== q `(,a 2)))) 574 | '(((_.0 2) (absento (3 _.0))))) 575 | 576 | (test "test 78" 577 | (run* (q) 578 | (fresh (d) 579 | (== `(3 . ,d) q) 580 | (absento `(3 . 4) q) 581 | (== '(3 . 4) d))) 582 | '()) 583 | 584 | (test "test 79" 585 | (run* (q) 586 | (fresh (d) 587 | (absento `(3 . 4) q) 588 | (== `(3 . ,d) q) 589 | (== '(3 . 4) d))) 590 | '()) 591 | 592 | (test "test 80" 593 | (run* (q) 594 | (fresh (d a c) 595 | (== `(3 . ,d) q) 596 | (absento `(3 . ,a) q) 597 | (== c d) 598 | (== `(3 . ,a) c))) 599 | '()) 600 | 601 | (test "test 81" 602 | (run* (q) 603 | (fresh (a b) 604 | (absento `(3 . ,a) `(,b . 4)) 605 | (== `(,a . ,b) q))) 606 | '(((_.0 . _.1) (=/= ((_.0 4) (_.1 3))) (absento ((3 . _.0) _.1))))) 607 | 608 | (test "test 82" 609 | (run* (q) 610 | (fresh (d) 611 | (== `(3 . ,d) q) 612 | (absento `(3 . 4) q))) 613 | '(((3 . _.0) (=/= ((_.0 4))) (absento ((3 . 4) _.0))))) 614 | 615 | (test "test 83" 616 | (run* (q) 617 | (fresh (d) 618 | (== `(3 . ,d) q) 619 | (== '(3 . 4) d)) 620 | (absento `(3 . 4) q)) 621 | '()) 622 | 623 | (test "test 84" 624 | (run* (q) 625 | (fresh (a b c d) 626 | (=/= `(,a . ,b) `(,c . ,d)) 627 | (absento a c) 628 | (== `(,a ,b ,c ,d) q))) 629 | '(((_.0 _.1 _.2 _.3) (absento (_.0 _.2))))) 630 | 631 | (test "test 84 b" 632 | (run* (q) 633 | (fresh (a b c d) 634 | (=/= `(,a . ,b) `(,c . ,d)) 635 | (absento c a) 636 | (== `(,a ,b ,c ,d) q))) 637 | '(((_.0 _.1 _.2 _.3) (absento (_.2 _.0))))) 638 | 639 | (test "test 85 a" 640 | (run* (q) 641 | (fresh (a b) 642 | (=/= a b) 643 | (absento a b) 644 | (== `(,a ,b) q))) 645 | '(((_.0 _.1) (absento (_.0 _.1))))) 646 | 647 | (test "test 85 b" 648 | (run* (q) 649 | (fresh (a b) 650 | (absento a b) 651 | (=/= a b) 652 | (== `(,a ,b) q))) 653 | '(((_.0 _.1) (absento (_.0 _.1))))) 654 | -------------------------------------------------------------------------------- /disequality-tests.scm: -------------------------------------------------------------------------------- 1 | (test "=/=-0" 2 | (run* (q) (=/= 5 q)) 3 | '((_.0 (=/= ((_.0 5)))))) 4 | 5 | (test "=/=-1" 6 | (run* (q) 7 | (=/= 3 q) 8 | (== q 3)) 9 | '()) 10 | 11 | (test "=/=-2" 12 | (run* (q) 13 | (== q 3) 14 | (=/= 3 q)) 15 | '()) 16 | 17 | (test "=/=-3" 18 | (run* (q) 19 | (fresh (x y) 20 | (=/= x y) 21 | (== x y))) 22 | '()) 23 | 24 | (test "=/=-4" 25 | (run* (q) 26 | (fresh (x y) 27 | (== x y) 28 | (=/= x y))) 29 | '()) 30 | 31 | (test "=/=-5" 32 | (run* (q) 33 | (fresh (x y) 34 | (=/= x y) 35 | (== 3 x) 36 | (== 3 y))) 37 | '()) 38 | 39 | (test "=/=-6" 40 | (run* (q) 41 | (fresh (x y) 42 | (== 3 x) 43 | (=/= x y) 44 | (== 3 y))) 45 | '()) 46 | 47 | (test "=/=-7" 48 | (run* (q) 49 | (fresh (x y) 50 | (== 3 x) 51 | (== 3 y) 52 | (=/= x y))) 53 | '()) 54 | 55 | (test "=/=-8" 56 | (run* (q) 57 | (fresh (x y) 58 | (== 3 x) 59 | (== 3 y) 60 | (=/= y x))) 61 | '()) 62 | 63 | (test "=/=-9" 64 | (run* (q) 65 | (fresh (x y z) 66 | (== x y) 67 | (== y z) 68 | (=/= x 4) 69 | (== z (+ 2 2)))) 70 | '()) 71 | 72 | (test "=/=-10" 73 | (run* (q) 74 | (fresh (x y z) 75 | (== x y) 76 | (== y z) 77 | (== z (+ 2 2)) 78 | (=/= x 4))) 79 | '()) 80 | 81 | (test "=/=-11" 82 | (run* (q) 83 | (fresh (x y z) 84 | (=/= x 4) 85 | (== y z) 86 | (== x y) 87 | (== z (+ 2 2)))) 88 | '()) 89 | 90 | (test "=/=-12" 91 | (run* (q) 92 | (fresh (x y z) 93 | (=/= x y) 94 | (== x `(0 ,z 1)) 95 | (== y `(0 1 1)))) 96 | '(_.0)) 97 | 98 | (test "=/=-13" 99 | (run* (q) 100 | (fresh (x y z) 101 | (=/= x y) 102 | (== x `(0 ,z 1)) 103 | (== y `(0 1 1)) 104 | (== z 1) 105 | (== `(,x ,y) q))) 106 | '()) 107 | 108 | (test "=/=-14" 109 | (run* (q) 110 | (fresh (x y z) 111 | (=/= x y) 112 | (== x `(0 ,z 1)) 113 | (== y `(0 1 1)) 114 | (== z 0))) 115 | '(_.0)) 116 | 117 | (test "=/=-15" 118 | (run* (q) 119 | (fresh (x y z) 120 | (== z 0) 121 | (=/= x y) 122 | (== x `(0 ,z 1)) 123 | (== y `(0 1 1)))) 124 | '(_.0)) 125 | 126 | (test "=/=-16" 127 | (run* (q) 128 | (fresh (x y z) 129 | (== x `(0 ,z 1)) 130 | (== y `(0 1 1)) 131 | (=/= x y))) 132 | '(_.0)) 133 | 134 | (test "=/=-17" 135 | (run* (q) 136 | (fresh (x y z) 137 | (== z 1) 138 | (=/= x y) 139 | (== x `(0 ,z 1)) 140 | (== y `(0 1 1)))) 141 | '()) 142 | 143 | (test "=/=-18" 144 | (run* (q) 145 | (fresh (x y z) 146 | (== z 1) 147 | (== x `(0 ,z 1)) 148 | (== y `(0 1 1)) 149 | (=/= x y))) 150 | '()) 151 | 152 | (test "=/=-19" 153 | (run* (q) 154 | (fresh (x y) 155 | (=/= `(,x 1) `(2 ,y)) 156 | (== x 2))) 157 | '(_.0)) 158 | 159 | (test "=/=-20" 160 | (run* (q) 161 | (fresh (x y) 162 | (=/= `(,x 1) `(2 ,y)) 163 | (== y 1))) 164 | '(_.0)) 165 | 166 | (test "=/=-21" 167 | (run* (q) 168 | (fresh (x y) 169 | (=/= `(,x 1) `(2 ,y)) 170 | (== x 2) 171 | (== y 1))) 172 | '()) 173 | 174 | (test "=/=-22" 175 | (run* (q) 176 | (fresh (x y) 177 | (=/= `(,x 1) `(2 ,y)) 178 | (== `(,x ,y) q))) 179 | '(((_.0 _.1) (=/= ((_.0 2) (_.1 1)))))) 180 | 181 | (test "=/=-23" 182 | (run* (q) 183 | (fresh (x y) 184 | (=/= `(,x 1) `(2 ,y)) 185 | (== x 2) 186 | (== `(,x ,y) q))) 187 | '(((2 _.0) (=/= ((_.0 1)))))) 188 | 189 | (test "=/=-24" 190 | (run* (q) 191 | (fresh (x y) 192 | (=/= `(,x 1) `(2 ,y)) 193 | (== x 2) 194 | (== y 9) 195 | (== `(,x ,y) q))) 196 | '((2 9))) 197 | 198 | (test "=/=-24b" 199 | (run* (q) 200 | (fresh (a d) 201 | (== `(,a . ,d) q) 202 | (=/= q `(5 . 6)) 203 | (== a 5) 204 | (== d 6))) 205 | '()) 206 | 207 | (test "=/=-25" 208 | (run* (q) 209 | (fresh (x y) 210 | (=/= `(,x 1) `(2 ,y)) 211 | (== x 2) 212 | (== y 1) 213 | (== `(,x ,y) q))) 214 | '()) 215 | 216 | (test "=/=-26" 217 | (run* (q) 218 | (fresh (a x z) 219 | (=/= a `(,x 1)) 220 | (== a `(,z 1)) 221 | (== x z))) 222 | '()) 223 | 224 | (test "=/=-27" 225 | (run* (q) 226 | (fresh (a x z) 227 | (=/= a `(,x 1)) 228 | (== a `(,z 1)) 229 | (== x 5) 230 | (== `(,x ,z) q))) 231 | '(((5 _.0) (=/= ((_.0 5)))))) 232 | 233 | (test "=/=-28" 234 | (run* (q) 235 | (=/= 3 4)) 236 | '(_.0)) 237 | 238 | (test "=/=-29" 239 | (run* (q) 240 | (=/= 3 3)) 241 | '()) 242 | 243 | (test "=/=-30" 244 | (run* (q) (=/= 5 q) 245 | (=/= 6 q) 246 | (== q 5)) 247 | '()) 248 | 249 | (test "=/=-31" 250 | (run* (q) 251 | (fresh (a d) 252 | (== `(,a . ,d) q) 253 | (=/= q `(5 . 6)) 254 | (== a 5))) 255 | '(((5 . _.0) (=/= ((_.0 6)))))) 256 | 257 | (test "=/=-32" 258 | (run* (q) 259 | (fresh (a) 260 | (== 3 a) 261 | (=/= a 4))) 262 | '(_.0)) 263 | 264 | (test "=/=-33" 265 | (run* (q) 266 | (=/= 4 q) 267 | (=/= 3 q)) 268 | '((_.0 (=/= ((_.0 3)) ((_.0 4)))))) 269 | 270 | (test "=/=-34" 271 | (run* (q) (=/= q 5) (=/= q 5)) 272 | '((_.0 (=/= ((_.0 5)))))) 273 | 274 | (test "=/=-35" 275 | (let ((foo (lambda (x) 276 | (fresh (a) 277 | (=/= x a))))) 278 | (run* (q) (fresh (a) (foo a)))) 279 | '(_.0)) 280 | 281 | (test "=/=-36" 282 | (let ((foo (lambda (x) 283 | (fresh (a) 284 | (=/= x a))))) 285 | (run* (q) (fresh (b) (foo b)))) 286 | '(_.0)) 287 | 288 | (test "=/=-37" 289 | (run* (q) 290 | (fresh (x y) 291 | (== `(,x ,y) q) 292 | (=/= x y))) 293 | '(((_.0 _.1) (=/= ((_.0 _.1)))))) 294 | 295 | (test "=/=-37b" 296 | (run* (q) 297 | (fresh (a d) 298 | (== `(,a . ,d) q) 299 | (=/= q `(5 . 6)))) 300 | '(((_.0 . _.1) (=/= ((_.0 5) (_.1 6)))))) 301 | 302 | (test "=/=-37c" 303 | (run* (q) 304 | (fresh (a d) 305 | (== `(,a . ,d) q) 306 | (=/= q `(5 . 6)) 307 | (== a 3))) 308 | '((3 . _.0))) 309 | 310 | (test "=/=-38" 311 | (run* (q) 312 | (fresh (x y) 313 | (== `(,x ,y) q) 314 | (=/= y x))) 315 | '(((_.0 _.1) (=/= ((_.0 _.1)))))) 316 | 317 | (test "=/=-39" 318 | (run* (q) 319 | (fresh (x y) 320 | (== `(,x ,y) q) 321 | (=/= x y) 322 | (=/= y x))) 323 | '(((_.0 _.1) (=/= ((_.0 _.1)))))) 324 | 325 | (test "=/=-40" 326 | (run* (q) 327 | (fresh (x y) 328 | (== `(,x ,y) q) 329 | (=/= x y) 330 | (=/= x y))) 331 | '(((_.0 _.1) (=/= ((_.0 _.1)))))) 332 | 333 | (test "=/=-41" 334 | (run* (q) (=/= q 5) (=/= 5 q)) 335 | '((_.0 (=/= ((_.0 5)))))) 336 | 337 | (test "=/=-42" 338 | (run* (q) 339 | (fresh (x y) 340 | (== `(,x ,y) q) 341 | (=/= `(,x ,y) `(5 6)) 342 | (=/= x 5))) 343 | '(((_.0 _.1) (=/= ((_.0 5)))))) 344 | 345 | (test "=/=-43" 346 | (run* (q) 347 | (fresh (x y) 348 | (== `(,x ,y) q) 349 | (=/= x 5) 350 | (=/= `(,x ,y) `(5 6)))) 351 | '(((_.0 _.1) (=/= ((_.0 5)))))) 352 | 353 | (test "=/=-44" 354 | (run* (q) 355 | (fresh (x y) 356 | (=/= x 5) 357 | (=/= `(,x ,y) `(5 6)) 358 | (== `(,x ,y) q))) 359 | '(((_.0 _.1) (=/= ((_.0 5)))))) 360 | 361 | (test "=/=-45" 362 | (run* (q) 363 | (fresh (x y) 364 | (=/= 5 x) 365 | (=/= `(,x ,y) `(5 6)) 366 | (== `(,x ,y) q))) 367 | '(((_.0 _.1) (=/= ((_.0 5)))))) 368 | 369 | (test "=/=-46" 370 | (run* (q) 371 | (fresh (x y) 372 | (=/= 5 x) 373 | (=/= `( ,y ,x) `(6 5)) 374 | (== `(,x ,y) q))) 375 | '(((_.0 _.1) (=/= ((_.0 5)))))) 376 | 377 | (test "=/=-47" 378 | (run* (x) 379 | (fresh (y z) 380 | (=/= x `(,y 2)) 381 | (== x `(,z 2)))) 382 | '((_.0 2))) 383 | 384 | (test "=/=-48" 385 | (run* (x) 386 | (fresh (y z) 387 | (=/= x `(,y 2)) 388 | (== x `((,z) 2)))) 389 | '(((_.0) 2))) 390 | 391 | (test "=/=-49" 392 | (run* (x) 393 | (fresh (y z) 394 | (=/= x `((,y) 2)) 395 | (== x `(,z 2)))) 396 | '((_.0 2))) 397 | 398 | (define distincto 399 | (lambda (l) 400 | (conde 401 | ((== l '())) 402 | ((fresh (a) (== l `(,a)))) 403 | ((fresh (a ad dd) 404 | (== l `(,a ,ad . ,dd)) 405 | (=/= a ad) 406 | (distincto `(,a . ,dd)) 407 | (distincto `(,ad . ,dd))))))) 408 | 409 | (test "=/=-50" 410 | (run* (q) 411 | (distincto `(2 3 ,q))) 412 | '((_.0 (=/= ((_.0 2)) ((_.0 3)))))) 413 | 414 | (define rembero 415 | (lambda (x ls out) 416 | (conde 417 | ((== '() ls) (== '() out)) 418 | ((fresh (a d res) 419 | (== `(,a . ,d) ls) 420 | (rembero x d res) 421 | (conde 422 | ((== a x) (== out res)) 423 | ((== `(,a . ,res) out)))))))) 424 | 425 | (test "=/=-51" 426 | (run* (q) (rembero 'a '(a b a c) q)) 427 | '((b c) (b a c) (a b c) (a b a c))) 428 | 429 | (test "=/=-52" 430 | (run* (q) (rembero 'a '(a b c) '(a b c))) 431 | '(_.0)) 432 | 433 | (define rembero 434 | (lambda (x ls out) 435 | (conde 436 | ((== '() ls) (== '() out)) 437 | ((fresh (a d res) 438 | (== `(,a . ,d) ls) 439 | (rembero x d res) 440 | (conde 441 | ((== a x) (== out res)) 442 | ((=/= a x) (== `(,a . ,res) out)))))))) 443 | 444 | (test "=/=-53" 445 | (run* (q) (rembero 'a '(a b a c) q)) 446 | '((b c))) 447 | 448 | (test "=/=-54" 449 | (run* (q) (rembero 'a '(a b c) '(a b c))) 450 | '()) 451 | 452 | (test "=/=-55" 453 | (run 1 (q) (=/= q #f)) 454 | '((_.0 (=/= ((_.0 #f)))))) 455 | -------------------------------------------------------------------------------- /matche.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | (require "mk.rkt") 3 | (require (for-syntax racket/syntax)) 4 | 5 | (provide matche lambdae defmatche) 6 | 7 | (define-for-syntax memp memf) 8 | 9 | (include "matche.scm") 10 | -------------------------------------------------------------------------------- /matche.scm: -------------------------------------------------------------------------------- 1 | ; new version of matche 2 | ; fixes depth related issues, and works with dots 3 | ; 4 | ; https://github.com/calvis/cKanren/blob/dev/cKanren/matche.rkt#L54 5 | 6 | ; Note that this definition is available at syntax phase in chez and vicare due to implicit 7 | ; phasing, but not in Racket (which uses explicit phasing). Racket already has a version available 8 | ; by default though, so that's fine. This definition isn't just isn't used in Racket. 9 | (define syntax->list 10 | (lambda (e) 11 | (syntax-case e () 12 | [() '()] 13 | [(x . r) (cons #'x (syntax->list #'r))]))) 14 | 15 | (define-syntax defmatche 16 | (lambda (stx) 17 | (syntax-case stx () 18 | [(defmatche (name args ...) clause ...) 19 | #'(define (name args ...) 20 | (matche (args ...) clause ...))]))) 21 | 22 | (define-syntax lambdae 23 | (syntax-rules () 24 | ((_ (x ...) c c* ...) 25 | (lambda (x ...) (matche (x ...) c c* ...))))) 26 | 27 | (define-syntax matche 28 | (lambda (stx) 29 | (syntax-case stx () 30 | [(matche (v ...) ([pat ...] g ...) ...) 31 | (let () 32 | (define remove-duplicates 33 | (lambda (ls eq-pred) 34 | (cond 35 | [(null? ls) '()] 36 | [(memp (lambda (x) (eq-pred (car ls) x)) (cdr ls)) 37 | (remove-duplicates (cdr ls) eq-pred)] 38 | [else (cons (car ls) (remove-duplicates (cdr ls) eq-pred))]))) 39 | (define parse-pattern 40 | (lambda (args pat) 41 | (syntax-case #`(#,args #,pat) () 42 | [(() ()) #'(() () ())] 43 | [((a args ...) [p pat ...]) 44 | (with-syntax ([(p^ (c ...) (x ...)) 45 | (parse-patterns-for-arg #'a #'p)]) 46 | (with-syntax ([([pat^ ...] (c^ ...) (x^ ...)) 47 | (parse-pattern #'(args ...) #'[pat ...])]) 48 | #'([p^ pat^ ...] (c ... c^ ...) (x ... x^ ...))))] 49 | [x (error 'parse-pattern "bad syntax ~s ~s" args pat)]))) 50 | (define parse-patterns-for-arg 51 | (lambda (v pat) 52 | (define loop 53 | (lambda (pat) 54 | (syntax-case pat (unquote ?? ?) ; ?? is the new _, since _ isn't legal in R6 55 | [(unquote ??) 56 | (with-syntax ([_new (generate-temporary #'?_)]) 57 | #'((unquote _new) () (_new)))] 58 | [(unquote x) 59 | (when (free-identifier=? #'x v) 60 | (error 'matche "argument ~s appears in pattern at an invalid depth" 61 | (syntax->datum #'x))) 62 | #'((unquote x) () (x))] 63 | [(unquote (? c x)) 64 | (when (free-identifier=? #'x v) 65 | (error 'matche "argument ~s appears in pattern at an invalid depth" 66 | (syntax->datum #'x))) 67 | #'((unquote x) ((c x)) (x))] 68 | [(a . d) 69 | (with-syntax ([((pat1 (c1 ...) (x1 ...)) 70 | (pat2 (c2 ...) (x2 ...))) 71 | (map loop (syntax->list #'(a d)))]) 72 | #'((pat1 . pat2) (c1 ... c2 ...) (x1 ... x2 ...)))] 73 | [x #'(x () ())]))) 74 | (syntax-case pat (unquote ?) 75 | [(unquote u) 76 | (cond 77 | [(and (identifier? #'u) 78 | (free-identifier=? v #'u)) 79 | #'((unquote u) () ())] 80 | [else (loop pat)])] 81 | [(unquote (? c u)) 82 | (cond 83 | [(and (identifier? #'u) 84 | (free-identifier=? v #'u)) 85 | #'((unquote u) ((c x)) ())] 86 | [else (loop pat)])] 87 | [else (loop pat)]))) 88 | (unless 89 | (andmap (lambda (y) (= (length (syntax->datum #'(v ...))) (length y))) 90 | (syntax->datum #'([pat ...] ...))) 91 | (error 'matche "pattern wrong length blah")) 92 | (with-syntax ([(([pat^ ...] (c ...) (x ...)) ...) 93 | (map (lambda (y) (parse-pattern #'(v ...) y)) 94 | (syntax->list #'([pat ...] ...)))]) 95 | (with-syntax ([((x^ ...) ...) 96 | (map (lambda (ls) 97 | (remove-duplicates (syntax->list ls) free-identifier=?)) 98 | (syntax->list #'((x ...) ...)))]) 99 | (with-syntax ([body 100 | #'(conde 101 | [(fresh (x^ ...) c ... (== `[pat^ ...] ls) g ...)] 102 | ...)]) 103 | #'(let ([ls (list v ...)]) body)))))] 104 | [(matche v (pat g ...) ...) 105 | #'(matche (v) ([pat] g ...) ...)]))) 106 | -------------------------------------------------------------------------------- /mk-chicken.scm: -------------------------------------------------------------------------------- 1 | (define (list-sort x y) (sort y x)) 2 | 3 | (define (exists p l) 4 | (if (null? l) 5 | #f 6 | (let ((res (p (car l)))) 7 | (if (null? (cdr l)) 8 | res 9 | (if res 10 | res 11 | (exists p (cdr l))))))) 12 | 13 | (define (find p l) 14 | (if (null? l) 15 | #f 16 | (if (p (car l)) 17 | (car l) 18 | (find p (cdr l))))) 19 | 20 | (define (remp p l) 21 | (if (null? l) 22 | '() 23 | (if (p (car l)) 24 | (remp p (cdr l)) 25 | (cons (car l) (remp p (cdr l)))))) 26 | 27 | (define (for-all p l) 28 | (if (null? l) 29 | #t 30 | (let ((res (p (car l)))) 31 | (if (null? (cdr l)) 32 | res 33 | (if res 34 | (for-all p (cdr l)) 35 | #f))))) 36 | 37 | (define call-with-string-output-port call-with-output-string) 38 | 39 | (load "mk.scm") 40 | -------------------------------------------------------------------------------- /mk-guile.scm: -------------------------------------------------------------------------------- 1 | (import (rnrs sorting (6)) 2 | (rnrs lists (6))) 3 | 4 | (define (sub1 n) 5 | (- n 1)) 6 | 7 | (define call-with-string-output-port call-with-output-string) 8 | 9 | (define (printf format-string . args) 10 | (display (apply format #f format-string args))) 11 | 12 | (load "mk.scm") 13 | -------------------------------------------------------------------------------- /mk.rkt: -------------------------------------------------------------------------------- 1 | #lang racket 2 | 3 | (require racket/trace) 4 | 5 | 6 | (provide run run* 7 | == =/= 8 | fresh eigen 9 | conde conda condu 10 | symbolo numbero ;; not-pairo 11 | absento 12 | project) 13 | 14 | ;; extra stuff for racket 15 | ;; due mostly to samth 16 | (define (list-sort f l) (sort l f)) 17 | (define (remp f l) (filter-not f l)) 18 | (define (call-with-string-output-port f) 19 | (define p (open-output-string)) 20 | (f p) 21 | (get-output-string p)) 22 | (define (exists f l) (ormap f l)) 23 | (define for-all andmap) 24 | (define (find f l) 25 | (cond [(memf f l) => car] [else #f])) 26 | (define memp memf) 27 | (define (var*? v) (var? (car v))) 28 | 29 | ;; actual code 30 | 31 | (include "mk.scm") 32 | -------------------------------------------------------------------------------- /mk.scm: -------------------------------------------------------------------------------- 1 | ;;; 28 November 02014 WEB 2 | ;;; 3 | ;;; * Fixed missing unquote before E in 'drop-Y-b/c-dup-var' 4 | ;;; 5 | ;;; * Updated 'rem-xx-from-d' to check against other constraints after 6 | ;;; unification, in order to remove redundant disequality constraints 7 | ;;; subsumed by absento constraints. 8 | 9 | ;;; newer version: Sept. 18 2013 (with eigens) 10 | ;;; Jason Hemann, Will Byrd, and Dan Friedman 11 | ;;; E = (e* . x*)*, where e* is a list of eigens and x* is a list of variables. 12 | ;;; Each e in e* is checked for any of its eigens be in any of its x*. Then it fails. 13 | ;;; Since eigen-occurs-check is chasing variables, we might as will do a memq instead 14 | ;;; of an eq? when an eigen is found through a chain of walks. See eigen-occurs-check. 15 | ;;; All the e* must be the eigens created as part of a single eigen. The reifier just 16 | ;;; abandons E, if it succeeds. If there is no failure by then, there were no eigen 17 | ;;; violations. 18 | 19 | (define empty-c '(() () () () () () ())) 20 | 21 | (define eigen-tag (vector 'eigen-tag)) 22 | 23 | (define-syntax inc 24 | (syntax-rules () 25 | ((_ e) (lambdaf@ () e)))) 26 | 27 | (define-syntax lambdaf@ 28 | (syntax-rules () 29 | ((_ () e) (lambda () e)))) 30 | 31 | (define-syntax lambdag@ 32 | (syntax-rules (:) 33 | ((_ (c) e) (lambda (c) e)) 34 | ((_ (c : B E S) e) 35 | (lambda (c) 36 | (let ((B (c->B c)) (E (c->E c)) (S (c->S c))) 37 | e))) 38 | ((_ (c : B E S D Y N T) e) 39 | (lambda (c) 40 | (let ((B (c->B c)) (E (c->E c)) (S (c->S c)) (D (c->D c)) 41 | (Y (c->Y c)) (N (c->N c)) (T (c->T c))) 42 | e))))) 43 | 44 | (define rhs 45 | (lambda (pr) 46 | (cdr pr))) 47 | 48 | (define lhs 49 | (lambda (pr) 50 | (car pr))) 51 | 52 | (define eigen-var 53 | (lambda () 54 | (vector eigen-tag))) 55 | 56 | (define eigen? 57 | (lambda (x) 58 | (and (vector? x) (eq? (vector-ref x 0) eigen-tag)))) 59 | 60 | (define var 61 | (lambda (dummy) 62 | (vector dummy))) 63 | 64 | (define var? 65 | (lambda (x) 66 | (and (vector? x) (not (eq? (vector-ref x 0) eigen-tag))))) 67 | 68 | (define walk 69 | (lambda (u S) 70 | (cond 71 | ((and (var? u) (assq u S)) => 72 | (lambda (pr) (walk (rhs pr) S))) 73 | (else u)))) 74 | 75 | (define prefix-S 76 | (lambda (S+ S) 77 | (cond 78 | ((eq? S+ S) '()) 79 | (else (cons (car S+) 80 | (prefix-S (cdr S+) S)))))) 81 | 82 | (define unify 83 | (lambda (u v s) 84 | (let ((u (walk u s)) 85 | (v (walk v s))) 86 | (cond 87 | ((eq? u v) s) 88 | ((var? u) (ext-s-check u v s)) 89 | ((var? v) (ext-s-check v u s)) 90 | ((and (pair? u) (pair? v)) 91 | (let ((s (unify (car u) (car v) s))) 92 | (and s (unify (cdr u) (cdr v) s)))) 93 | ((or (eigen? u) (eigen? v)) #f) 94 | ((equal? u v) s) 95 | (else #f))))) 96 | 97 | (define occurs-check 98 | (lambda (x v s) 99 | (let ((v (walk v s))) 100 | (cond 101 | ((var? v) (eq? v x)) 102 | ((pair? v) 103 | (or 104 | (occurs-check x (car v) s) 105 | (occurs-check x (cdr v) s))) 106 | (else #f))))) 107 | 108 | (define eigen-occurs-check 109 | (lambda (e* x s) 110 | (let ((x (walk x s))) 111 | (cond 112 | ((var? x) #f) 113 | ((eigen? x) (memq x e*)) 114 | ((pair? x) 115 | (or 116 | (eigen-occurs-check e* (car x) s) 117 | (eigen-occurs-check e* (cdr x) s))) 118 | (else #f))))) 119 | 120 | (define empty-f (lambdaf@ () (mzero))) 121 | 122 | (define ext-s-check 123 | (lambda (x v s) 124 | (cond 125 | ((occurs-check x v s) #f) 126 | (else (cons `(,x . ,v) s))))) 127 | 128 | (define unify* 129 | (lambda (S+ S) 130 | (unify (map lhs S+) (map rhs S+) S))) 131 | 132 | (define-syntax case-inf 133 | (syntax-rules () 134 | ((_ e (() e0) ((f^) e1) ((c^) e2) ((c f) e3)) 135 | (let ((c-inf e)) 136 | (cond 137 | ((not c-inf) e0) 138 | ((procedure? c-inf) (let ((f^ c-inf)) e1)) 139 | ((not (and (pair? c-inf) 140 | (procedure? (cdr c-inf)))) 141 | (let ((c^ c-inf)) e2)) 142 | (else (let ((c (car c-inf)) (f (cdr c-inf))) 143 | e3))))))) 144 | 145 | (define-syntax fresh 146 | (syntax-rules () 147 | ((_ (x ...) g0 g ...) 148 | (lambdag@ (c : B E S D Y N T) 149 | (inc 150 | (let ((x (var 'x)) ...) 151 | (let ((B (append `(,x ...) B))) 152 | (bind* (g0 `(,B ,E ,S ,D ,Y ,N ,T)) g ...)))))))) 153 | 154 | (define-syntax eigen 155 | (syntax-rules () 156 | ((_ (x ...) g0 g ...) 157 | (lambdag@ (c : B E S) 158 | (let ((x (eigen-var)) ...) 159 | ((fresh () (eigen-absento `(,x ...) B) g0 g ...) c)))))) 160 | 161 | (define-syntax bind* 162 | (syntax-rules () 163 | ((_ e) e) 164 | ((_ e g0 g ...) (bind* (bind e g0) g ...)))) 165 | 166 | (define bind 167 | (lambda (c-inf g) 168 | (case-inf c-inf 169 | (() (mzero)) 170 | ((f) (inc (bind (f) g))) 171 | ((c) (g c)) 172 | ((c f) (mplus (g c) (lambdaf@ () (bind (f) g))))))) 173 | 174 | (define-syntax run 175 | (syntax-rules () 176 | ((_ n (q) g0 g ...) 177 | (take n 178 | (lambdaf@ () 179 | ((fresh (q) g0 g ... 180 | (lambdag@ (final-c) 181 | (let ((z ((reify q) final-c))) 182 | (choice z empty-f)))) 183 | empty-c)))) 184 | ((_ n (q0 q1 q ...) g0 g ...) 185 | (run n (x) (fresh (q0 q1 q ...) g0 g ... (== `(,q0 ,q1 ,q ...) x)))))) 186 | 187 | (define-syntax run* 188 | (syntax-rules () 189 | ((_ (q0 q ...) g0 g ...) (run #f (q0 q ...) g0 g ...)))) 190 | 191 | (define take 192 | (lambda (n f) 193 | (cond 194 | ((and n (zero? n)) '()) 195 | (else 196 | (case-inf (f) 197 | (() '()) 198 | ((f) (take n f)) 199 | ((c) (cons c '())) 200 | ((c f) (cons c 201 | (take (and n (- n 1)) f)))))))) 202 | 203 | (define-syntax conde 204 | (syntax-rules () 205 | ((_ (g0 g ...) (g1 g^ ...) ...) 206 | (lambdag@ (c) 207 | (inc 208 | (mplus* 209 | (bind* (g0 c) g ...) 210 | (bind* (g1 c) g^ ...) ...)))))) 211 | 212 | (define-syntax mplus* 213 | (syntax-rules () 214 | ((_ e) e) 215 | ((_ e0 e ...) (mplus e0 216 | (lambdaf@ () (mplus* e ...)))))) 217 | 218 | (define mplus 219 | (lambda (c-inf f) 220 | (case-inf c-inf 221 | (() (f)) 222 | ((f^) (inc (mplus (f) f^))) 223 | ((c) (choice c f)) 224 | ((c f^) (choice c (lambdaf@ () (mplus (f) f^))))))) 225 | 226 | 227 | (define c->B (lambda (c) (car c))) 228 | (define c->E (lambda (c) (cadr c))) 229 | (define c->S (lambda (c) (caddr c))) 230 | (define c->D (lambda (c) (cadddr c))) 231 | (define c->Y (lambda (c) (cadddr (cdr c)))) 232 | (define c->N (lambda (c) (cadddr (cddr c)))) 233 | (define c->T (lambda (c) (cadddr (cdddr c)))) 234 | 235 | (define-syntax conda 236 | (syntax-rules () 237 | ((_ (g0 g ...) (g1 g^ ...) ...) 238 | (lambdag@ (c) 239 | (inc 240 | (ifa ((g0 c) g ...) 241 | ((g1 c) g^ ...) ...)))))) 242 | 243 | (define-syntax ifa 244 | (syntax-rules () 245 | ((_) (mzero)) 246 | ((_ (e g ...) b ...) 247 | (let loop ((c-inf e)) 248 | (case-inf c-inf 249 | (() (ifa b ...)) 250 | ((f) (inc (loop (f)))) 251 | ((a) (bind* c-inf g ...)) 252 | ((a f) (bind* c-inf g ...))))))) 253 | 254 | (define-syntax condu 255 | (syntax-rules () 256 | ((_ (g0 g ...) (g1 g^ ...) ...) 257 | (lambdag@ (c) 258 | (inc 259 | (ifu ((g0 c) g ...) 260 | ((g1 c) g^ ...) ...)))))) 261 | 262 | (define-syntax ifu 263 | (syntax-rules () 264 | ((_) (mzero)) 265 | ((_ (e g ...) b ...) 266 | (let loop ((c-inf e)) 267 | (case-inf c-inf 268 | (() (ifu b ...)) 269 | ((f) (inc (loop (f)))) 270 | ((c) (bind* c-inf g ...)) 271 | ((c f) (bind* (unit c) g ...))))))) 272 | 273 | (define mzero (lambda () #f)) 274 | 275 | (define unit (lambda (c) c)) 276 | 277 | (define choice (lambda (c f) (cons c f))) 278 | 279 | (define tagged? 280 | (lambda (S Y y^) 281 | (exists (lambda (y) (eqv? (walk y S) y^)) Y))) 282 | 283 | (define untyped-var? 284 | (lambda (S Y N t^) 285 | (let ((in-type? (lambda (y) (eq? (walk y S) t^)))) 286 | (and (var? t^) 287 | (not (exists in-type? Y)) 288 | (not (exists in-type? N)))))) 289 | 290 | (define-syntax project 291 | (syntax-rules () 292 | ((_ (x ...) g g* ...) 293 | (lambdag@ (c : B E S) 294 | (let ((x (walk* x S)) ...) 295 | ((fresh () g g* ...) c)))))) 296 | 297 | (define walk* 298 | (lambda (v S) 299 | (let ((v (walk v S))) 300 | (cond 301 | ((var? v) v) 302 | ((pair? v) 303 | (cons (walk* (car v) S) (walk* (cdr v) S))) 304 | (else v))))) 305 | 306 | (define reify-S 307 | (lambda (v S) 308 | (let ((v (walk v S))) 309 | (cond 310 | ((var? v) 311 | (let ((n (length S))) 312 | (let ((name (reify-name n))) 313 | (cons `(,v . ,name) S)))) 314 | ((pair? v) 315 | (let ((S (reify-S (car v) S))) 316 | (reify-S (cdr v) S))) 317 | (else S))))) 318 | 319 | (define reify-name 320 | (lambda (n) 321 | (string->symbol 322 | (string-append "_" "." (number->string n))))) 323 | 324 | (define drop-dot 325 | (lambda (X) 326 | (map (lambda (t) 327 | (let ((a (lhs t)) 328 | (d (rhs t))) 329 | `(,a ,d))) 330 | X))) 331 | 332 | (define sorter 333 | (lambda (ls) 334 | (list-sort lex<=? ls))) 335 | 336 | (define lex<=? 337 | (lambda (x y) 338 | (string<=? (datum->string x) (datum->string y)))) 339 | 340 | (define datum->string 341 | (lambda (x) 342 | (call-with-string-output-port 343 | (lambda (p) (display x p))))) 344 | 345 | (define anyvar? 346 | (lambda (u r) 347 | (cond 348 | ((pair? u) 349 | (or (anyvar? (car u) r) 350 | (anyvar? (cdr u) r))) 351 | (else (var? (walk u r)))))) 352 | 353 | (define anyeigen? 354 | (lambda (u r) 355 | (cond 356 | ((pair? u) 357 | (or (anyeigen? (car u) r) 358 | (anyeigen? (cdr u) r))) 359 | (else (eigen? (walk u r)))))) 360 | 361 | (define member* 362 | (lambda (u v) 363 | (cond 364 | ((equal? u v) #t) 365 | ((pair? v) 366 | (or (member* u (car v)) (member* u (cdr v)))) 367 | (else #f)))) 368 | 369 | ;;; 370 | 371 | (define drop-N-b/c-const 372 | (lambdag@ (c : B E S D Y N T) 373 | (let ((const? (lambda (n) 374 | (not (var? (walk n S)))))) 375 | (cond 376 | ((find const? N) => 377 | (lambda (n) `(,B ,E ,S ,D ,Y ,(remq1 n N) ,T))) 378 | (else c))))) 379 | 380 | (define drop-Y-b/c-const 381 | (lambdag@ (c : B E S D Y N T) 382 | (let ((const? (lambda (y) 383 | (not (var? (walk y S)))))) 384 | (cond 385 | ((find const? Y) => 386 | (lambda (y) `(,B ,E ,S ,D ,(remq1 y Y) ,N ,T))) 387 | (else c))))) 388 | 389 | (define remq1 390 | (lambda (elem ls) 391 | (cond 392 | ((null? ls) '()) 393 | ((eq? (car ls) elem) (cdr ls)) 394 | (else (cons (car ls) (remq1 elem (cdr ls))))))) 395 | 396 | (define same-var? 397 | (lambda (v) 398 | (lambda (v^) 399 | (and (var? v) (var? v^) (eq? v v^))))) 400 | 401 | (define find-dup 402 | (lambda (f S) 403 | (lambda (set) 404 | (let loop ((set^ set)) 405 | (cond 406 | ((null? set^) #f) 407 | (else 408 | (let ((elem (car set^))) 409 | (let ((elem^ (walk elem S))) 410 | (cond 411 | ((find (lambda (elem^^) 412 | ((f elem^) (walk elem^^ S))) 413 | (cdr set^)) 414 | elem) 415 | (else (loop (cdr set^)))))))))))) 416 | 417 | (define drop-N-b/c-dup-var 418 | (lambdag@ (c : B E S D Y N T) 419 | (cond 420 | (((find-dup same-var? S) N) => 421 | (lambda (n) `(,B ,E ,S ,D ,Y ,(remq1 n N) ,T))) 422 | (else c)))) 423 | 424 | (define drop-Y-b/c-dup-var 425 | (lambdag@ (c : B E S D Y N T) 426 | (cond 427 | (((find-dup same-var? S) Y) => 428 | (lambda (y) 429 | `(,B ,E ,S ,D ,(remq1 y Y) ,N ,T))) 430 | (else c)))) 431 | 432 | (define var-type-mismatch? 433 | (lambda (S Y N t1^ t2^) 434 | (cond 435 | ((num? S N t1^) (not (num? S N t2^))) 436 | ((sym? S Y t1^) (not (sym? S Y t2^))) 437 | (else #f)))) 438 | 439 | (define term-ununifiable? 440 | (lambda (S Y N t1 t2) 441 | (let ((t1^ (walk t1 S)) 442 | (t2^ (walk t2 S))) 443 | (cond 444 | ((or (untyped-var? S Y N t1^) (untyped-var? S Y N t2^)) #f) 445 | ((var? t1^) (var-type-mismatch? S Y N t1^ t2^)) 446 | ((var? t2^) (var-type-mismatch? S Y N t2^ t1^)) 447 | ((and (pair? t1^) (pair? t2^)) 448 | (or (term-ununifiable? S Y N (car t1^) (car t2^)) 449 | (term-ununifiable? S Y N (cdr t1^) (cdr t2^)))) 450 | (else (not (eqv? t1^ t2^))))))) 451 | 452 | (define T-term-ununifiable? 453 | (lambda (S Y N) 454 | (lambda (t1) 455 | (let ((t1^ (walk t1 S))) 456 | (letrec 457 | ((t2-check 458 | (lambda (t2) 459 | (let ((t2^ (walk t2 S))) 460 | (cond 461 | ((pair? t2^) (and 462 | (term-ununifiable? S Y N t1^ t2^) 463 | (t2-check (car t2^)) 464 | (t2-check (cdr t2^)))) 465 | (else (term-ununifiable? S Y N t1^ t2^))))))) 466 | t2-check))))) 467 | 468 | (define num? 469 | (lambda (S N n) 470 | (let ((n (walk n S))) 471 | (cond 472 | ((var? n) (tagged? S N n)) 473 | (else (number? n)))))) 474 | 475 | (define sym? 476 | (lambda (S Y y) 477 | (let ((y (walk y S))) 478 | (cond 479 | ((var? y) (tagged? S Y y)) 480 | (else (symbol? y)))))) 481 | 482 | (define drop-T-b/c-Y-and-N 483 | (lambdag@ (c : B E S D Y N T) 484 | (let ((drop-t? (T-term-ununifiable? S Y N))) 485 | (cond 486 | ((find (lambda (t) ((drop-t? (lhs t)) (rhs t))) T) => 487 | (lambda (t) `(,B ,E ,S ,D ,Y ,N ,(remq1 t T)))) 488 | (else c))))) 489 | 490 | (define move-T-to-D-b/c-t2-atom 491 | (lambdag@ (c : B E S D Y N T) 492 | (cond 493 | ((exists (lambda (t) 494 | (let ((t2^ (walk (rhs t) S))) 495 | (cond 496 | ((and (not (untyped-var? S Y N t2^)) 497 | (not (pair? t2^))) 498 | (let ((T (remq1 t T))) 499 | `(,B ,E ,S ((,t) . ,D) ,Y ,N ,T))) 500 | (else #f)))) 501 | T)) 502 | (else c)))) 503 | 504 | (define terms-pairwise=? 505 | (lambda (pr-a^ pr-d^ t-a^ t-d^ S) 506 | (or 507 | (and (term=? pr-a^ t-a^ S) 508 | (term=? pr-d^ t-a^ S)) 509 | (and (term=? pr-a^ t-d^ S) 510 | (term=? pr-d^ t-a^ S))))) 511 | 512 | (define T-superfluous-pr? 513 | (lambda (S Y N T) 514 | (lambda (pr) 515 | (let ((pr-a^ (walk (lhs pr) S)) 516 | (pr-d^ (walk (rhs pr) S))) 517 | (cond 518 | ((exists 519 | (lambda (t) 520 | (let ((t-a^ (walk (lhs t) S)) 521 | (t-d^ (walk (rhs t) S))) 522 | (terms-pairwise=? pr-a^ pr-d^ t-a^ t-d^ S))) 523 | T) 524 | (for-all 525 | (lambda (t) 526 | (let ((t-a^ (walk (lhs t) S)) 527 | (t-d^ (walk (rhs t) S))) 528 | (or 529 | (not (terms-pairwise=? pr-a^ pr-d^ t-a^ t-d^ S)) 530 | (untyped-var? S Y N t-d^) 531 | (pair? t-d^)))) 532 | T)) 533 | (else #f)))))) 534 | 535 | (define drop-from-D-b/c-T 536 | (lambdag@ (c : B E S D Y N T) 537 | (cond 538 | ((find 539 | (lambda (d) 540 | (exists 541 | (T-superfluous-pr? S Y N T) 542 | d)) 543 | D) => 544 | (lambda (d) `(,B ,E ,S ,(remq1 d D) ,Y ,N ,T))) 545 | (else c)))) 546 | 547 | (define drop-t-b/c-t2-occurs-t1 548 | (lambdag@ (c : B E S D Y N T) 549 | (cond 550 | ((find (lambda (t) 551 | (let ((t-a^ (walk (lhs t) S)) 552 | (t-d^ (walk (rhs t) S))) 553 | (mem-check t-d^ t-a^ S))) 554 | T) => 555 | (lambda (t) 556 | `(,B ,E ,S ,D ,Y ,N ,(remq1 t T)))) 557 | (else c)))) 558 | 559 | (define split-t-move-to-d-b/c-pair 560 | (lambdag@ (c : B E S D Y N T) 561 | (cond 562 | ((exists 563 | (lambda (t) 564 | (let ((t2^ (walk (rhs t) S))) 565 | (cond 566 | ((pair? t2^) (let ((ta `(,(lhs t) . ,(car t2^))) 567 | (td `(,(lhs t) . ,(cdr t2^)))) 568 | (let ((T `(,ta ,td . ,(remq1 t T)))) 569 | `(,B ,E ,S ((,t) . ,D) ,Y ,N ,T)))) 570 | (else #f)))) 571 | T)) 572 | (else c)))) 573 | 574 | (define find-d-conflict 575 | (lambda (S Y N) 576 | (lambda (D) 577 | (find 578 | (lambda (d) 579 | (exists (lambda (pr) 580 | (term-ununifiable? S Y N (lhs pr) (rhs pr))) 581 | d)) 582 | D)))) 583 | 584 | (define drop-D-b/c-Y-or-N 585 | (lambdag@ (c : B E S D Y N T) 586 | (cond 587 | (((find-d-conflict S Y N) D) => 588 | (lambda (d) `(,B ,E ,S ,(remq1 d D) ,Y ,N ,T))) 589 | (else c)))) 590 | 591 | (define cycle 592 | (lambdag@ (c) 593 | (let loop ((c^ c) 594 | (fns^ (LOF)) 595 | (n (length (LOF)))) 596 | (cond 597 | ((zero? n) c^) 598 | ((null? fns^) (loop c^ (LOF) n)) 599 | (else 600 | (let ((c^^ ((car fns^) c^))) 601 | (cond 602 | ((not (eq? c^^ c^)) 603 | (loop c^^ (cdr fns^) (length (LOF)))) 604 | (else (loop c^ (cdr fns^) (sub1 n)))))))))) 605 | 606 | (define absento 607 | (lambda (u v) 608 | (lambdag@ (c : B E S D Y N T) 609 | (cond 610 | ((mem-check u v S) (mzero)) 611 | (else (unit `(,B ,E ,S ,D ,Y ,N ((,u . ,v) . ,T)))))))) 612 | 613 | (define eigen-absento 614 | (lambda (e* x*) 615 | (lambdag@ (c : B E S D Y N T) 616 | (cond 617 | ((eigen-occurs-check e* x* S) (mzero)) 618 | (else (unit `(,B ((,e* . ,x*) . ,E) ,S ,D ,Y ,N ,T))))))) 619 | 620 | (define mem-check 621 | (lambda (u t S) 622 | (let ((t (walk t S))) 623 | (cond 624 | ((pair? t) 625 | (or (term=? u t S) 626 | (mem-check u (car t) S) 627 | (mem-check u (cdr t) S))) 628 | (else (term=? u t S)))))) 629 | 630 | (define term=? 631 | (lambda (u t S) 632 | (cond 633 | ((unify u t S) => 634 | (lambda (S0) 635 | (eq? S0 S))) 636 | (else #f)))) 637 | 638 | (define ground-non-? 639 | (lambda (pred) 640 | (lambda (u S) 641 | (let ((u (walk u S))) 642 | (cond 643 | ((var? u) #f) 644 | (else (not (pred u)))))))) 645 | ;; moved 646 | (define ground-non-symbol? 647 | (ground-non-? symbol?)) 648 | 649 | (define ground-non-number? 650 | (ground-non-? number?)) 651 | 652 | (define symbolo 653 | (lambda (u) 654 | (lambdag@ (c : B E S D Y N T) 655 | (cond 656 | ((ground-non-symbol? u S) (mzero)) 657 | ((mem-check u N S) (mzero)) 658 | (else (unit `(,B ,E ,S ,D (,u . ,Y) ,N ,T))))))) 659 | 660 | (define numbero 661 | (lambda (u) 662 | (lambdag@ (c : B E S D Y N T) 663 | (cond 664 | ((ground-non-number? u S) (mzero)) 665 | ((mem-check u Y S) (mzero)) 666 | (else (unit `(,B ,E ,S ,D ,Y (,u . ,N) ,T))))))) 667 | ;; end moved 668 | 669 | (define =/= ;; moved 670 | (lambda (u v) 671 | (lambdag@ (c : B E S D Y N T) 672 | (cond 673 | ((unify u v S) => 674 | (lambda (S0) 675 | (let ((pfx (prefix-S S0 S))) 676 | (cond 677 | ((null? pfx) (mzero)) 678 | (else (unit `(,B ,E ,S (,pfx . ,D) ,Y ,N ,T))))))) 679 | (else c))))) 680 | 681 | (define == 682 | (lambda (u v) 683 | (lambdag@ (c : B E S D Y N T) 684 | (cond 685 | ((unify u v S) => 686 | (lambda (S0) 687 | (cond 688 | ((==fail-check B E S0 D Y N T) (mzero)) 689 | (else (unit `(,B ,E ,S0 ,D ,Y ,N ,T)))))) 690 | (else (mzero)))))) 691 | 692 | (define succeed (== #f #f)) 693 | 694 | (define fail (== #f #t)) 695 | 696 | (define ==fail-check 697 | (lambda (B E S0 D Y N T) 698 | (cond 699 | ((eigen-absento-fail-check E S0) #t) 700 | ((atomic-fail-check S0 Y ground-non-symbol?) #t) 701 | ((atomic-fail-check S0 N ground-non-number?) #t) 702 | ((symbolo-numbero-fail-check S0 Y N) #t) 703 | ((=/=-fail-check S0 D) #t) 704 | ((absento-fail-check S0 T) #t) 705 | (else #f)))) 706 | 707 | (define eigen-absento-fail-check 708 | (lambda (E S0) 709 | (exists (lambda (e*/x*) (eigen-occurs-check (car e*/x*) (cdr e*/x*) S0)) E))) 710 | 711 | (define atomic-fail-check 712 | (lambda (S A pred) 713 | (exists (lambda (a) (pred (walk a S) S)) A))) 714 | 715 | (define symbolo-numbero-fail-check 716 | (lambda (S A N) 717 | (let ((N (map (lambda (n) (walk n S)) N))) 718 | (exists (lambda (a) (exists (same-var? (walk a S)) N)) 719 | A)))) 720 | 721 | (define absento-fail-check 722 | (lambda (S T) 723 | (exists (lambda (t) (mem-check (lhs t) (rhs t) S)) T))) 724 | 725 | (define =/=-fail-check 726 | (lambda (S D) 727 | (exists (d-fail-check S) D))) 728 | 729 | (define d-fail-check 730 | (lambda (S) 731 | (lambda (d) 732 | (cond 733 | ((unify* d S) => 734 | (lambda (S+) (eq? S+ S))) 735 | (else #f))))) 736 | 737 | (define reify 738 | (lambda (x) 739 | (lambda (c) 740 | (let ((c (cycle c))) 741 | (let* ((S (c->S c)) 742 | (D (walk* (c->D c) S)) 743 | (Y (walk* (c->Y c) S)) 744 | (N (walk* (c->N c) S)) 745 | (T (walk* (c->T c) S))) 746 | (let ((v (walk* x S))) 747 | (let ((R (reify-S v '()))) 748 | (reify+ v R 749 | (let ((D (remp 750 | (lambda (d) 751 | (let ((dw (walk* d S))) 752 | (or 753 | (anyvar? dw R) 754 | (anyeigen? dw R)))) 755 | (rem-xx-from-d c)))) 756 | (rem-subsumed D)) 757 | (remp 758 | (lambda (y) (var? (walk y R))) 759 | Y) 760 | (remp 761 | (lambda (n) (var? (walk n R))) 762 | N) 763 | (remp (lambda (t) 764 | (or (anyeigen? t R) (anyvar? t R))) T))))))))) 765 | 766 | (define reify+ 767 | (lambda (v R D Y N T) 768 | (form (walk* v R) 769 | (walk* D R) 770 | (walk* Y R) 771 | (walk* N R) 772 | (rem-subsumed-T (walk* T R))))) 773 | 774 | (define form 775 | (lambda (v D Y N T) 776 | (let ((fd (sort-D D)) 777 | (fy (sorter Y)) 778 | (fn (sorter N)) 779 | (ft (sorter T))) 780 | (let ((fd (if (null? fd) fd 781 | (let ((fd (drop-dot-D fd))) 782 | `((=/= . ,fd))))) 783 | (fy (if (null? fy) fy `((sym . ,fy)))) 784 | (fn (if (null? fn) fn `((num . ,fn)))) 785 | (ft (if (null? ft) ft 786 | (let ((ft (drop-dot ft))) 787 | `((absento . ,ft)))))) 788 | (cond 789 | ((and (null? fd) (null? fy) 790 | (null? fn) (null? ft)) 791 | v) 792 | (else (append `(,v) fd fn fy ft))))))) 793 | 794 | (define sort-D 795 | (lambda (D) 796 | (sorter 797 | (map sort-d D)))) 798 | 799 | (define sort-d 800 | (lambda (d) 801 | (list-sort 802 | (lambda (x y) 803 | (lex<=? (car x) (car y))) 804 | (map sort-pr d)))) 805 | 806 | (define drop-dot-D 807 | (lambda (D) 808 | (map drop-dot D))) 809 | 810 | (define lex<-reified-name? 811 | (lambda (r) 812 | (charstring r) 0) 815 | #\_))) 816 | 817 | (define sort-pr 818 | (lambda (pr) 819 | (let ((l (lhs pr)) 820 | (r (rhs pr))) 821 | (cond 822 | ((lex<-reified-name? r) pr) 823 | ((lex<=? r l) `(,r . ,l)) 824 | (else pr))))) 825 | 826 | (define rem-subsumed 827 | (lambda (D) 828 | (let rem-subsumed ((D D) (d^* '())) 829 | (cond 830 | ((null? D) d^*) 831 | ((or (subsumed? (car D) (cdr D)) 832 | (subsumed? (car D) d^*)) 833 | (rem-subsumed (cdr D) d^*)) 834 | (else (rem-subsumed (cdr D) 835 | (cons (car D) d^*))))))) 836 | 837 | (define subsumed? 838 | (lambda (d d*) 839 | (cond 840 | ((null? d*) #f) 841 | (else 842 | (let ((d^ (unify* (car d*) d))) 843 | (or 844 | (and d^ (eq? d^ d)) 845 | (subsumed? d (cdr d*)))))))) 846 | 847 | (define rem-xx-from-d 848 | (lambdag@ (c : B E S D Y N T) 849 | (let ((D (walk* D S))) 850 | (remp not 851 | (map (lambda (d) 852 | (cond 853 | ((unify* d S) => 854 | (lambda (S0) 855 | (cond 856 | ((==fail-check B E S0 '() Y N T) #f) 857 | (else (prefix-S S0 S))))) 858 | (else #f))) 859 | D))))) 860 | 861 | (define rem-subsumed-T 862 | (lambda (T) 863 | (let rem-subsumed ((T T) (T^ '())) 864 | (cond 865 | ((null? T) T^) 866 | (else 867 | (let ((lit (lhs (car T))) 868 | (big (rhs (car T)))) 869 | (cond 870 | ((or (subsumed-T? lit big (cdr T)) 871 | (subsumed-T? lit big T^)) 872 | (rem-subsumed (cdr T) T^)) 873 | (else (rem-subsumed (cdr T) 874 | (cons (car T) T^)))))))))) 875 | 876 | (define subsumed-T? 877 | (lambda (lit big T) 878 | (cond 879 | ((null? T) #f) 880 | (else 881 | (let ((lit^ (lhs (car T))) 882 | (big^ (rhs (car T)))) 883 | (or 884 | (and (eq? big big^) (member* lit^ lit)) 885 | (subsumed-T? lit big (cdr T)))))))) 886 | 887 | (define LOF 888 | (lambda () 889 | `(,drop-N-b/c-const ,drop-Y-b/c-const ,drop-Y-b/c-dup-var 890 | ,drop-N-b/c-dup-var ,drop-D-b/c-Y-or-N ,drop-T-b/c-Y-and-N 891 | ,move-T-to-D-b/c-t2-atom ,split-t-move-to-d-b/c-pair 892 | ,drop-from-D-b/c-T ,drop-t-b/c-t2-occurs-t1))) 893 | -------------------------------------------------------------------------------- /numbero-tests.scm: -------------------------------------------------------------------------------- 1 | (test "numbero-1" 2 | (run* (q) (numbero q)) 3 | '((_.0 (num _.0)))) 4 | 5 | (test "numbero-2" 6 | (run* (q) (numbero q) (== 5 q)) 7 | '(5)) 8 | 9 | (test "numbero-3" 10 | (run* (q) (== 5 q) (numbero q)) 11 | '(5)) 12 | 13 | (test "numbero-4" 14 | (run* (q) (== 'x q) (numbero q)) 15 | '()) 16 | 17 | (test "numbero-5" 18 | (run* (q) (numbero q) (== 'x q)) 19 | '()) 20 | 21 | (test "numbero-6" 22 | (run* (q) (numbero q) (== `(1 . 2) q)) 23 | '()) 24 | 25 | (test "numbero-7" 26 | (run* (q) (== `(1 . 2) q) (numbero q)) 27 | '()) 28 | 29 | (test "numbero-8" 30 | (run* (q) (fresh (x) (numbero x))) 31 | '(_.0)) 32 | 33 | (test "numbero-9" 34 | (run* (q) (fresh (x) (numbero x))) 35 | '(_.0)) 36 | 37 | (test "numbero-10" 38 | (run* (q) (fresh (x) (numbero x) (== x q))) 39 | '((_.0 (num _.0)))) 40 | 41 | (test "numbero-11" 42 | (run* (q) (fresh (x) (numbero q) (== x q) (numbero x))) 43 | '((_.0 (num _.0)))) 44 | 45 | (test "numbero-12" 46 | (run* (q) (fresh (x) (numbero q) (numbero x) (== x q))) 47 | '((_.0 (num _.0)))) 48 | 49 | (test "numbero-13" 50 | (run* (q) (fresh (x) (== x q) (numbero q) (numbero x))) 51 | '((_.0 (num _.0)))) 52 | 53 | (test "numbero-14-a" 54 | (run* (q) (fresh (x) (numbero q) (== 5 x))) 55 | '((_.0 (num _.0)))) 56 | 57 | (test "numbero-14-b" 58 | (run* (q) (fresh (x) (numbero q) (== 5 x) (== x q))) 59 | '(5)) 60 | 61 | (test "numbero-15" 62 | (run* (q) (fresh (x) (== q x) (numbero q) (== 'y x))) 63 | '()) 64 | 65 | (test "numbero-16-a" 66 | (run* (q) (numbero q) (=/= 'y q)) 67 | '((_.0 (num _.0)))) 68 | 69 | (test "numbero-16-b" 70 | (run* (q) (=/= 'y q) (numbero q)) 71 | '((_.0 (num _.0)))) 72 | 73 | (test "numbero-17" 74 | (run* (q) (numbero q) (=/= `(1 . 2) q)) 75 | '((_.0 (num _.0)))) 76 | 77 | (test "numbero-18" 78 | (run* (q) (numbero q) (=/= 5 q)) 79 | '((_.0 (=/= ((_.0 5))) (num _.0)))) 80 | 81 | (test "numbero-19" 82 | (run* (q) 83 | (fresh (x y) 84 | (numbero x) 85 | (numbero y) 86 | (== `(,x ,y) q))) 87 | '(((_.0 _.1) (num _.0 _.1)))) 88 | 89 | (test "numbero-20" 90 | (run* (q) 91 | (fresh (x y) 92 | (== `(,x ,y) q) 93 | (numbero x) 94 | (numbero y))) 95 | '(((_.0 _.1) (num _.0 _.1)))) 96 | 97 | (test "numbero-21" 98 | (run* (q) 99 | (fresh (x y) 100 | (== `(,x ,y) q) 101 | (numbero x) 102 | (numbero x))) 103 | '(((_.0 _.1) (num _.0)))) 104 | 105 | (test "numbero-22" 106 | (run* (q) 107 | (fresh (x y) 108 | (numbero x) 109 | (numbero x) 110 | (== `(,x ,y) q))) 111 | '(((_.0 _.1) (num _.0)))) 112 | 113 | (test "numbero-23" 114 | (run* (q) 115 | (fresh (x y) 116 | (numbero x) 117 | (== `(,x ,y) q) 118 | (numbero x))) 119 | '(((_.0 _.1) (num _.0)))) 120 | 121 | (test "numbero-24-a" 122 | (run* (q) 123 | (fresh (w x y z) 124 | (=/= `(,w . ,x) `(,y . ,z)) 125 | (numbero w) 126 | (numbero z))) 127 | '(_.0)) 128 | 129 | (test "numbero-24-b" 130 | (run* (q) 131 | (fresh (w x y z) 132 | (=/= `(,w . ,x) `(,y . ,z)) 133 | (numbero w) 134 | (numbero z) 135 | (== `(,w ,x ,y ,z) q))) 136 | '(((_.0 _.1 _.2 _.3) 137 | (=/= ((_.0 _.2) (_.1 _.3))) 138 | (num _.0 _.3)))) 139 | 140 | (test "numbero-24-c" 141 | (run* (q) 142 | (fresh (w x y z) 143 | (=/= `(,w . ,x) `(,y . ,z)) 144 | (numbero w) 145 | (numbero y) 146 | (== `(,w ,x ,y ,z) q))) 147 | '(((_.0 _.1 _.2 _.3) 148 | (=/= ((_.0 _.2) (_.1 _.3))) 149 | (num _.0 _.2)))) 150 | 151 | (test "numbero-24-d" 152 | (run* (q) 153 | (fresh (w x y z) 154 | (=/= `(,w . ,x) `(,y . ,z)) 155 | (numbero w) 156 | (numbero y) 157 | (== w y) 158 | (== `(,w ,x ,y ,z) q))) 159 | '(((_.0 _.1 _.0 _.2) 160 | (=/= ((_.1 _.2))) 161 | (num _.0)))) 162 | 163 | (test "numbero-25" 164 | (run* (q) 165 | (fresh (w x) 166 | (=/= `(,w . ,x) `(a . b)) 167 | (== `(,w ,x) q))) 168 | '(((_.0 _.1) (=/= ((_.0 a) (_.1 b)))))) 169 | 170 | (test "numbero-26" 171 | (run* (q) 172 | (fresh (w x) 173 | (=/= `(,w . ,x) `(a . b)) 174 | (numbero w) 175 | (== `(,w ,x) q))) 176 | '(((_.0 _.1) (num _.0)))) 177 | 178 | (test "numbero-27" 179 | (run* (q) 180 | (fresh (w x) 181 | (numbero w) 182 | (=/= `(,w . ,x) `(a . b)) 183 | (== `(,w ,x) q))) 184 | '(((_.0 _.1) (num _.0)))) 185 | 186 | (test "numbero-28" 187 | (run* (q) 188 | (fresh (w x) 189 | (numbero w) 190 | (=/= `(a . b) `(,w . ,x)) 191 | (== `(,w ,x) q))) 192 | '(((_.0 _.1) (num _.0)))) 193 | 194 | (test "numbero-29" 195 | (run* (q) 196 | (fresh (w x) 197 | (numbero w) 198 | (=/= `(a . ,x) `(,w . b)) 199 | (== `(,w ,x) q))) 200 | '(((_.0 _.1) (num _.0)))) 201 | 202 | (test "numbero-30" 203 | (run* (q) 204 | (fresh (w x) 205 | (numbero w) 206 | (=/= `(5 . ,x) `(,w . b)) 207 | (== `(,w ,x) q))) 208 | '(((_.0 _.1) (=/= ((_.0 5) (_.1 b))) (num _.0)))) 209 | 210 | (test "numbero-31" 211 | (run* (q) 212 | (fresh (x y z a b) 213 | (numbero x) 214 | (numbero y) 215 | (numbero z) 216 | (numbero a) 217 | (numbero b) 218 | (== `(,y ,z ,x ,b) `(,z ,x ,y ,a)) 219 | (== q `(,x ,y ,z ,a ,b)))) 220 | '(((_.0 _.0 _.0 _.1 _.1) (num _.0 _.1)))) 221 | 222 | (test "numbero-32" 223 | (run* (q) 224 | (fresh (x y z a b) 225 | (== q `(,x ,y ,z ,a ,b)) 226 | (== `(,y ,z ,x ,b) `(,z ,x ,y ,a)) 227 | (numbero x) 228 | (numbero a))) 229 | '(((_.0 _.0 _.0 _.1 _.1) (num _.0 _.1)))) 230 | -------------------------------------------------------------------------------- /numbers.scm: -------------------------------------------------------------------------------- 1 | (define build-num 2 | (lambda (n) 3 | (cond 4 | ((odd? n) 5 | (cons 1 6 | (build-num (quotient (- n 1) 2)))) 7 | ((and (not (zero? n)) (even? n)) 8 | (cons 0 9 | (build-num (quotient n 2)))) 10 | ((zero? n) '())))) 11 | 12 | (define zeroo 13 | (lambda (n) 14 | (== '() n))) 15 | 16 | (define poso 17 | (lambda (n) 18 | (fresh (a d) 19 | (== `(,a . ,d) n)))) 20 | 21 | (define >1o 22 | (lambda (n) 23 | (fresh (a ad dd) 24 | (== `(,a ,ad . ,dd) n)))) 25 | 26 | (define full-addero 27 | (lambda (b x y r c) 28 | (conde 29 | ((== 0 b) (== 0 x) (== 0 y) (== 0 r) (== 0 c)) 30 | ((== 1 b) (== 0 x) (== 0 y) (== 1 r) (== 0 c)) 31 | ((== 0 b) (== 1 x) (== 0 y) (== 1 r) (== 0 c)) 32 | ((== 1 b) (== 1 x) (== 0 y) (== 0 r) (== 1 c)) 33 | ((== 0 b) (== 0 x) (== 1 y) (== 1 r) (== 0 c)) 34 | ((== 1 b) (== 0 x) (== 1 y) (== 0 r) (== 1 c)) 35 | ((== 0 b) (== 1 x) (== 1 y) (== 0 r) (== 1 c)) 36 | ((== 1 b) (== 1 x) (== 1 y) (== 1 r) (== 1 c))))) 37 | 38 | (define addero 39 | (lambda (d n m r) 40 | (conde 41 | ((== 0 d) (== '() m) (== n r)) 42 | ((== 0 d) (== '() n) (== m r) 43 | (poso m)) 44 | ((== 1 d) (== '() m) 45 | (addero 0 n '(1) r)) 46 | ((== 1 d) (== '() n) (poso m) 47 | (addero 0 '(1) m r)) 48 | ((== '(1) n) (== '(1) m) 49 | (fresh (a c) 50 | (== `(,a ,c) r) 51 | (full-addero d 1 1 a c))) 52 | ((== '(1) n) (gen-addero d n m r)) 53 | ((== '(1) m) (>1o n) (>1o r) 54 | (addero d '(1) n r)) 55 | ((>1o n) (gen-addero d n m r))))) 56 | 57 | (define gen-addero 58 | (lambda (d n m r) 59 | (fresh (a b c e x y z) 60 | (== `(,a . ,x) n) 61 | (== `(,b . ,y) m) (poso y) 62 | (== `(,c . ,z) r) (poso z) 63 | (full-addero d a b c e) 64 | (addero e x y z)))) 65 | 66 | (define pluso 67 | (lambda (n m k) 68 | (addero 0 n m k))) 69 | 70 | (define minuso 71 | (lambda (n m k) 72 | (pluso m k n))) 73 | 74 | (define *o 75 | (lambda (n m p) 76 | (conde 77 | ((== '() n) (== '() p)) 78 | ((poso n) (== '() m) (== '() p)) 79 | ((== '(1) n) (poso m) (== m p)) 80 | ((>1o n) (== '(1) m) (== n p)) 81 | ((fresh (x z) 82 | (== `(0 . ,x) n) (poso x) 83 | (== `(0 . ,z) p) (poso z) 84 | (>1o m) 85 | (*o x m z))) 86 | ((fresh (x y) 87 | (== `(1 . ,x) n) (poso x) 88 | (== `(0 . ,y) m) (poso y) 89 | (*o m n p))) 90 | ((fresh (x y) 91 | (== `(1 . ,x) n) (poso x) 92 | (== `(1 . ,y) m) (poso y) 93 | (odd-*o x n m p)))))) 94 | 95 | (define odd-*o 96 | (lambda (x n m p) 97 | (fresh (q) 98 | (bound-*o q p n m) 99 | (*o x m q) 100 | (pluso `(0 . ,q) m p)))) 101 | 102 | (define bound-*o 103 | (lambda (q p n m) 104 | (conde 105 | ((== '() q) (poso p)) 106 | ((fresh (a0 a1 a2 a3 x y z) 107 | (== `(,a0 . ,x) q) 108 | (== `(,a1 . ,y) p) 109 | (conde 110 | ((== '() n) 111 | (== `(,a2 . ,z) m) 112 | (bound-*o x y z '())) 113 | ((== `(,a3 . ,z) n) 114 | (bound-*o x y z m)))))))) 115 | 116 | (define =lo 117 | (lambda (n m) 118 | (conde 119 | ((== '() n) (== '() m)) 120 | ((== '(1) n) (== '(1) m)) 121 | ((fresh (a x b y) 122 | (== `(,a . ,x) n) (poso x) 123 | (== `(,b . ,y) m) (poso y) 124 | (=lo x y)))))) 125 | 126 | (define 1o m)) 131 | ((fresh (a x b y) 132 | (== `(,a . ,x) n) (poso x) 133 | (== `(,b . ,y) m) (poso y) 134 | (1o b) (=lo n b) (pluso r b n)) 218 | ((== '(1) b) (poso q) (pluso r '(1) n)) 219 | ((== '() b) (poso q) (== r n)) 220 | ((== '(0 1) b) 221 | (fresh (a ad dd) 222 | (poso dd) 223 | (== `(,a ,ad . ,dd) n) 224 | (exp2 n '() q) 225 | (fresh (s) 226 | (splito n dd r s)))) 227 | ((fresh (a ad add ddd) 228 | (conde 229 | ((== '(1 1) b)) 230 | ((== `(,a ,ad ,add . ,ddd) b)))) 231 | (1o n) (== '(1) q) 263 | (fresh (s) 264 | (splito n b s '(1)))) 265 | ((fresh (q1 b2) 266 | (== `(0 . ,q1) q) 267 | (poso q1) 268 | (1o q) 285 | (fresh (q1 nq1) 286 | (pluso q1 '(1) q) 287 | (repeated-mul n q1 nq1) 288 | (*o nq1 n nq)))))) 289 | 290 | (define expo 291 | (lambda (b q n) 292 | (logo n b q '()))) 293 | 294 | -------------------------------------------------------------------------------- /symbolo-numbero-tests.scm: -------------------------------------------------------------------------------- 1 | (test "symbolo-numbero-1" 2 | (run* (q) (symbolo q) (numbero q)) 3 | '()) 4 | 5 | (test "symbolo-numbero-2" 6 | (run* (q) (numbero q) (symbolo q)) 7 | '()) 8 | 9 | (test "symbolo-numbero-3" 10 | (run* (q) 11 | (fresh (x) 12 | (numbero x) 13 | (symbolo x))) 14 | '()) 15 | 16 | (test "symbolo-numbero-4" 17 | (run* (q) 18 | (fresh (x) 19 | (symbolo x) 20 | (numbero x))) 21 | '()) 22 | 23 | (test "symbolo-numbero-5" 24 | (run* (q) 25 | (numbero q) 26 | (fresh (x) 27 | (symbolo x) 28 | (== x q))) 29 | '()) 30 | 31 | (test "symbolo-numbero-6" 32 | (run* (q) 33 | (symbolo q) 34 | (fresh (x) 35 | (numbero x) 36 | (== x q))) 37 | '()) 38 | 39 | (test "symbolo-numbero-7" 40 | (run* (q) 41 | (fresh (x) 42 | (numbero x) 43 | (== x q)) 44 | (symbolo q)) 45 | '()) 46 | 47 | (test "symbolo-numbero-7" 48 | (run* (q) 49 | (fresh (x) 50 | (symbolo x) 51 | (== x q)) 52 | (numbero q)) 53 | '()) 54 | 55 | (test "symbolo-numbero-8" 56 | (run* (q) 57 | (fresh (x) 58 | (== x q) 59 | (symbolo x)) 60 | (numbero q)) 61 | '()) 62 | 63 | (test "symbolo-numbero-9" 64 | (run* (q) 65 | (fresh (x) 66 | (== x q) 67 | (numbero x)) 68 | (symbolo q)) 69 | '()) 70 | 71 | (test "symbolo-numbero-10" 72 | (run* (q) 73 | (symbolo q) 74 | (fresh (x) 75 | (numbero x))) 76 | '((_.0 (sym _.0)))) 77 | 78 | (test "symbolo-numbero-11" 79 | (run* (q) 80 | (numbero q) 81 | (fresh (x) 82 | (symbolo x))) 83 | '((_.0 (num _.0)))) 84 | 85 | (test "symbolo-numbero-12" 86 | (run* (q) 87 | (fresh (x y) 88 | (symbolo x) 89 | (== `(,x ,y) q))) 90 | '(((_.0 _.1) (sym _.0)))) 91 | 92 | (test "symbolo-numbero-13" 93 | (run* (q) 94 | (fresh (x y) 95 | (numbero x) 96 | (== `(,x ,y) q))) 97 | '(((_.0 _.1) (num _.0)))) 98 | 99 | (test "symbolo-numbero-14" 100 | (run* (q) 101 | (fresh (x y) 102 | (numbero x) 103 | (symbolo y) 104 | (== `(,x ,y) q))) 105 | '(((_.0 _.1) (num _.0) (sym _.1)))) 106 | 107 | (test "symbolo-numbero-15" 108 | (run* (q) 109 | (fresh (x y) 110 | (numbero x) 111 | (== `(,x ,y) q) 112 | (symbolo y))) 113 | '(((_.0 _.1) (num _.0) (sym _.1)))) 114 | 115 | (test "symbolo-numbero-16" 116 | (run* (q) 117 | (fresh (x y) 118 | (== `(,x ,y) q) 119 | (numbero x) 120 | (symbolo y))) 121 | '(((_.0 _.1) (num _.0) (sym _.1)))) 122 | 123 | (test "symbolo-numbero-17" 124 | (run* (q) 125 | (fresh (x y) 126 | (== `(,x ,y) q) 127 | (numbero x) 128 | (symbolo y)) 129 | (fresh (w z) 130 | (== `(,w ,z) q))) 131 | '(((_.0 _.1) (num _.0) (sym _.1)))) 132 | 133 | (test "symbolo-numbero-18" 134 | (run* (q) 135 | (fresh (x y) 136 | (== `(,x ,y) q) 137 | (numbero x) 138 | (symbolo y)) 139 | (fresh (w z) 140 | (== `(,w ,z) q) 141 | (== w 5))) 142 | '(((5 _.0) (sym _.0)))) 143 | 144 | (test "symbolo-numbero-19" 145 | (run* (q) 146 | (fresh (x y) 147 | (== `(,x ,y) q) 148 | (numbero x) 149 | (symbolo y)) 150 | (fresh (w z) 151 | (== 'a z) 152 | (== `(,w ,z) q))) 153 | '(((_.0 a) (num _.0)))) 154 | 155 | (test "symbolo-numbero-20" 156 | (run* (q) 157 | (fresh (x y) 158 | (== `(,x ,y) q) 159 | (numbero x) 160 | (symbolo y)) 161 | (fresh (w z) 162 | (== `(,w ,z) q) 163 | (== 'a z))) 164 | '(((_.0 a) (num _.0)))) 165 | 166 | (test "symbolo-numbero-21" 167 | (run* (q) 168 | (fresh (x y) 169 | (== `(,x ,y) q) 170 | (=/= `(5 a) q))) 171 | '(((_.0 _.1) (=/= ((_.0 5) (_.1 a)))))) 172 | 173 | (test "symbolo-numbero-22" 174 | (run* (q) 175 | (fresh (x y) 176 | (== `(,x ,y) q) 177 | (=/= `(5 a) q) 178 | (symbolo x))) 179 | '(((_.0 _.1) (sym _.0)))) 180 | 181 | (test "symbolo-numbero-23" 182 | (run* (q) 183 | (fresh (x y) 184 | (== `(,x ,y) q) 185 | (symbolo x) 186 | (=/= `(5 a) q))) 187 | '(((_.0 _.1) (sym _.0)))) 188 | 189 | (test "symbolo-numbero-24" 190 | (run* (q) 191 | (fresh (x y) 192 | (symbolo x) 193 | (== `(,x ,y) q) 194 | (=/= `(5 a) q))) 195 | '(((_.0 _.1) (sym _.0)))) 196 | 197 | (test "symbolo-numbero-25" 198 | (run* (q) 199 | (fresh (x y) 200 | (=/= `(5 a) q) 201 | (symbolo x) 202 | (== `(,x ,y) q))) 203 | '(((_.0 _.1) (sym _.0)))) 204 | 205 | (test "symbolo-numbero-26" 206 | (run* (q) 207 | (fresh (x y) 208 | (=/= `(5 a) q) 209 | (== `(,x ,y) q) 210 | (symbolo x))) 211 | '(((_.0 _.1) (sym _.0)))) 212 | 213 | (test "symbolo-numbero-27" 214 | (run* (q) 215 | (fresh (x y) 216 | (== `(,x ,y) q) 217 | (=/= `(5 a) q) 218 | (numbero y))) 219 | '(((_.0 _.1) (num _.1)))) 220 | 221 | (test "symbolo-numbero-28" 222 | (run* (q) 223 | (fresh (x y) 224 | (== `(,x ,y) q) 225 | (numbero y) 226 | (=/= `(5 a) q))) 227 | '(((_.0 _.1) (num _.1)))) 228 | 229 | (test "symbolo-numbero-29" 230 | (run* (q) 231 | (fresh (x y) 232 | (numbero y) 233 | (== `(,x ,y) q) 234 | (=/= `(5 a) q))) 235 | '(((_.0 _.1) (num _.1)))) 236 | 237 | (test "symbolo-numbero-30" 238 | (run* (q) 239 | (fresh (x y) 240 | (=/= `(5 a) q) 241 | (numbero y) 242 | (== `(,x ,y) q))) 243 | '(((_.0 _.1) (num _.1)))) 244 | 245 | (test "symbolo-numbero-31" 246 | (run* (q) 247 | (fresh (x y) 248 | (=/= `(5 a) q) 249 | (== `(,x ,y) q) 250 | (numbero y))) 251 | '(((_.0 _.1) (num _.1)))) 252 | 253 | (test "symbolo-numbero-32" 254 | (run* (q) 255 | (fresh (x y) 256 | (=/= `(,x ,y) q) 257 | (numbero x) 258 | (symbolo y))) 259 | '(_.0)) 260 | 261 | (test "symbolo-numbero-33" 262 | (run* (q) 263 | (fresh (x y) 264 | (numbero x) 265 | (=/= `(,x ,y) q) 266 | (symbolo y))) 267 | '(_.0)) 268 | 269 | (test "symbolo-numbero-34" 270 | (run* (q) 271 | (fresh (x y) 272 | (numbero x) 273 | (symbolo y) 274 | (=/= `(,x ,y) q))) 275 | '(_.0)) 276 | -------------------------------------------------------------------------------- /symbolo-tests.scm: -------------------------------------------------------------------------------- 1 | (test "symbolo-1" 2 | (run* (q) (symbolo q)) 3 | '((_.0 (sym _.0)))) 4 | 5 | (test "symbolo-2" 6 | (run* (q) (symbolo q) (== 'x q)) 7 | '(x)) 8 | 9 | (test "symbolo-3" 10 | (run* (q) (== 'x q) (symbolo q)) 11 | '(x)) 12 | 13 | (test "symbolo-4" 14 | (run* (q) (== 5 q) (symbolo q)) 15 | '()) 16 | 17 | (test "symbolo-5" 18 | (run* (q) (symbolo q) (== 5 q)) 19 | '()) 20 | 21 | (test "symbolo-6" 22 | (run* (q) (symbolo q) (== `(1 . 2) q)) 23 | '()) 24 | 25 | (test "symbolo-7" 26 | (run* (q) (== `(1 . 2) q) (symbolo q)) 27 | '()) 28 | 29 | (test "symbolo-8" 30 | (run* (q) (fresh (x) (symbolo x))) 31 | '(_.0)) 32 | 33 | (test "symbolo-9" 34 | (run* (q) (fresh (x) (symbolo x))) 35 | '(_.0)) 36 | 37 | (test "symbolo-10" 38 | (run* (q) (fresh (x) (symbolo x) (== x q))) 39 | '((_.0 (sym _.0)))) 40 | 41 | (test "symbolo-11" 42 | (run* (q) (fresh (x) (symbolo q) (== x q) (symbolo x))) 43 | '((_.0 (sym _.0)))) 44 | 45 | (test "symbolo-12" 46 | (run* (q) (fresh (x) (symbolo q) (symbolo x) (== x q))) 47 | '((_.0 (sym _.0)))) 48 | 49 | (test "symbolo-13" 50 | (run* (q) (fresh (x) (== x q) (symbolo q) (symbolo x))) 51 | '((_.0 (sym _.0)))) 52 | 53 | (test "symbolo-14-a" 54 | (run* (q) (fresh (x) (symbolo q) (== 'y x))) 55 | '((_.0 (sym _.0)))) 56 | 57 | (test "symbolo-14-b" 58 | (run* (q) (fresh (x) (symbolo q) (== 'y x) (== x q))) 59 | '(y)) 60 | 61 | (test "symbolo-15" 62 | (run* (q) (fresh (x) (== q x) (symbolo q) (== 5 x))) 63 | '()) 64 | 65 | (test "symbolo-16-a" 66 | (run* (q) (symbolo q) (=/= 5 q)) 67 | '((_.0 (sym _.0)))) 68 | 69 | (test "symbolo-16-b" 70 | (run* (q) (=/= 5 q) (symbolo q)) 71 | '((_.0 (sym _.0)))) 72 | 73 | (test "symbolo-17" 74 | (run* (q) (symbolo q) (=/= `(1 . 2) q)) 75 | '((_.0 (sym _.0)))) 76 | 77 | (test "symbolo-18" 78 | (run* (q) (symbolo q) (=/= 'y q)) 79 | '((_.0 (=/= ((_.0 y))) (sym _.0)))) 80 | 81 | (test "symbolo-19" 82 | (run* (q) 83 | (fresh (x y) 84 | (symbolo x) 85 | (symbolo y) 86 | (== `(,x ,y) q))) 87 | '(((_.0 _.1) (sym _.0 _.1)))) 88 | 89 | (test "symbolo-20" 90 | (run* (q) 91 | (fresh (x y) 92 | (== `(,x ,y) q) 93 | (symbolo x) 94 | (symbolo y))) 95 | '(((_.0 _.1) (sym _.0 _.1)))) 96 | 97 | (test "symbolo-21" 98 | (run* (q) 99 | (fresh (x y) 100 | (== `(,x ,y) q) 101 | (symbolo x) 102 | (symbolo x))) 103 | '(((_.0 _.1) (sym _.0)))) 104 | 105 | (test "symbolo-22" 106 | (run* (q) 107 | (fresh (x y) 108 | (symbolo x) 109 | (symbolo x) 110 | (== `(,x ,y) q))) 111 | '(((_.0 _.1) (sym _.0)))) 112 | 113 | (test "symbolo-23" 114 | (run* (q) 115 | (fresh (x y) 116 | (symbolo x) 117 | (== `(,x ,y) q) 118 | (symbolo x))) 119 | '(((_.0 _.1) (sym _.0)))) 120 | 121 | (test "symbolo-24-a" 122 | (run* (q) 123 | (fresh (w x y z) 124 | (=/= `(,w . ,x) `(,y . ,z)) 125 | (symbolo w) 126 | (symbolo z))) 127 | '(_.0)) 128 | 129 | (test "symbolo-24-b" 130 | (run* (q) 131 | (fresh (w x y z) 132 | (=/= `(,w . ,x) `(,y . ,z)) 133 | (symbolo w) 134 | (symbolo z) 135 | (== `(,w ,x ,y ,z) q))) 136 | '(((_.0 _.1 _.2 _.3) 137 | (=/= ((_.0 _.2) (_.1 _.3))) 138 | (sym _.0 _.3)))) 139 | 140 | (test "symbolo-24-c" 141 | (run* (q) 142 | (fresh (w x y z) 143 | (=/= `(,w . ,x) `(,y . ,z)) 144 | (symbolo w) 145 | (symbolo y) 146 | (== `(,w ,x ,y ,z) q))) 147 | '(((_.0 _.1 _.2 _.3) 148 | (=/= ((_.0 _.2) (_.1 _.3))) 149 | (sym _.0 _.2)))) 150 | 151 | (test "symbolo-24-d" 152 | (run* (q) 153 | (fresh (w x y z) 154 | (=/= `(,w . ,x) `(,y . ,z)) 155 | (symbolo w) 156 | (symbolo y) 157 | (== w y) 158 | (== `(,w ,x ,y ,z) q))) 159 | '(((_.0 _.1 _.0 _.2) 160 | (=/= ((_.1 _.2))) 161 | (sym _.0)))) 162 | 163 | (test "symbolo-25" 164 | (run* (q) 165 | (fresh (w x) 166 | (=/= `(,w . ,x) `(5 . 6)) 167 | (== `(,w ,x) q))) 168 | '(((_.0 _.1) (=/= ((_.0 5) (_.1 6)))))) 169 | 170 | (test "symbolo-26" 171 | (run* (q) 172 | (fresh (w x) 173 | (=/= `(,w . ,x) `(5 . 6)) 174 | (symbolo w) 175 | (== `(,w ,x) q))) 176 | '(((_.0 _.1) (sym _.0)))) 177 | 178 | (test "symbolo-27" 179 | (run* (q) 180 | (fresh (w x) 181 | (symbolo w) 182 | (=/= `(,w . ,x) `(5 . 6)) 183 | (== `(,w ,x) q))) 184 | '(((_.0 _.1) (sym _.0)))) 185 | 186 | (test "symbolo-28" 187 | (run* (q) 188 | (fresh (w x) 189 | (symbolo w) 190 | (=/= `(5 . 6) `(,w . ,x)) 191 | (== `(,w ,x) q))) 192 | '(((_.0 _.1) (sym _.0)))) 193 | 194 | (test "symbolo-29" 195 | (run* (q) 196 | (fresh (w x) 197 | (symbolo w) 198 | (=/= `(5 . ,x) `(,w . 6)) 199 | (== `(,w ,x) q))) 200 | '(((_.0 _.1) (sym _.0)))) 201 | 202 | (test "symbolo-30" 203 | (run* (q) 204 | (fresh (w x) 205 | (symbolo w) 206 | (=/= `(z . ,x) `(,w . 6)) 207 | (== `(,w ,x) q))) 208 | '(((_.0 _.1) (=/= ((_.0 z) (_.1 6))) (sym _.0)))) 209 | 210 | (test "symbolo-31-a" 211 | (run* (q) 212 | (fresh (w x y z) 213 | (== x 5) 214 | (=/= `(,w ,y) `(,x ,z)) 215 | (== w 5) 216 | (== `(,w ,x ,y ,z) q))) 217 | '(((5 5 _.0 _.1) (=/= ((_.0 _.1)))))) 218 | 219 | (test "symbolo-31-b" 220 | (run* (q) 221 | (fresh (w x y z) 222 | (=/= `(,w ,y) `(,x ,z)) 223 | (== w 5) 224 | (== x 5) 225 | (== `(,w ,x ,y ,z) q))) 226 | '(((5 5 _.0 _.1) (=/= ((_.0 _.1)))))) 227 | 228 | (test "symbolo-31-c" 229 | (run* (q) 230 | (fresh (w x y z) 231 | (== w 5) 232 | (=/= `(,w ,y) `(,x ,z)) 233 | (== `(,w ,x ,y ,z) q) 234 | (== x 5))) 235 | '(((5 5 _.0 _.1) (=/= ((_.0 _.1)))))) 236 | 237 | (test "symbolo-31-d" 238 | (run* (q) 239 | (fresh (w x y z) 240 | (== w 5) 241 | (== x 5) 242 | (=/= `(,w ,y) `(,x ,z)) 243 | (== `(,w ,x ,y ,z) q))) 244 | '(((5 5 _.0 _.1) (=/= ((_.0 _.1)))))) 245 | 246 | 247 | (test "symbolo-32-a" 248 | (run* (q) 249 | (fresh (w x y z) 250 | (== x 'a) 251 | (=/= `(,w ,y) `(,x ,z)) 252 | (== w 'a) 253 | (== `(,w ,x ,y ,z) q))) 254 | '(((a a _.0 _.1) (=/= ((_.0 _.1)))))) 255 | 256 | (test "symbolo-32-b" 257 | (run* (q) 258 | (fresh (w x y z) 259 | (=/= `(,w ,y) `(,x ,z)) 260 | (== w 'a) 261 | (== x 'a) 262 | (== `(,w ,x ,y ,z) q))) 263 | '(((a a _.0 _.1) (=/= ((_.0 _.1)))))) 264 | 265 | (test "symbolo-32-c" 266 | (run* (q) 267 | (fresh (w x y z) 268 | (== w 'a) 269 | (=/= `(,w ,y) `(,x ,z)) 270 | (== `(,w ,x ,y ,z) q) 271 | (== x 'a))) 272 | '(((a a _.0 _.1) (=/= ((_.0 _.1)))))) 273 | 274 | (test "symbolo-32-d" 275 | (run* (q) 276 | (fresh (w x y z) 277 | (== w 'a) 278 | (== x 'a) 279 | (=/= `(,w ,y) `(,x ,z)) 280 | (== `(,w ,x ,y ,z) q))) 281 | '(((a a _.0 _.1) (=/= ((_.0 _.1)))))) 282 | -------------------------------------------------------------------------------- /test-all.scm: -------------------------------------------------------------------------------- 1 | (load "test-check.scm") 2 | 3 | (printf "==-tests\n") 4 | (load "==-tests.scm") 5 | 6 | (printf "symbolo-tests\n") 7 | (load "symbolo-tests.scm") 8 | 9 | (printf "numbero-tests\n") 10 | (load "numbero-tests.scm") 11 | 12 | (printf "symbolo-numbero-tests\n") 13 | (load "symbolo-numbero-tests.scm") 14 | 15 | (printf "disequality-tests\n") 16 | (load "disequality-tests.scm") 17 | 18 | (printf "absento-closure-tests\n") 19 | (load "absento-closure-tests.scm") 20 | 21 | (printf "absento-tests\n") 22 | (load "absento-tests.scm") 23 | 24 | (printf "test-infer\n") 25 | (load "test-infer.scm") 26 | 27 | (printf "test-interp\n") 28 | (load "test-interp.scm") 29 | 30 | (printf "test-quines\n") 31 | (load "test-quines.scm") 32 | 33 | (printf "test-numbers\n") 34 | (load "numbers.scm") 35 | (load "test-numbers.scm") 36 | -------------------------------------------------------------------------------- /test-check.scm: -------------------------------------------------------------------------------- 1 | (define-syntax test 2 | (syntax-rules () 3 | ((_ title tested-expression expected-result) 4 | (begin 5 | (printf "Testing ~s\n" title) 6 | (let* ((expected expected-result) 7 | (produced tested-expression)) 8 | (or (equal? expected produced) 9 | (printf "Failed: ~a~%Expected: ~a~%Computed: ~a~%" 10 | 'tested-expression expected produced))))))) 11 | -------------------------------------------------------------------------------- /test-infer.scm: -------------------------------------------------------------------------------- 1 | (define !- 2 | (lambda (exp env t) 3 | (conde 4 | [(symbolo exp) (lookupo exp env t)] 5 | [(fresh (x e t-x t-e) 6 | (== `(lambda (,x) ,e) exp) 7 | (symbolo x) 8 | (not-in-envo 'lambda env) 9 | (== `(-> ,t-x ,t-e) t) 10 | (!- e `((,x . ,t-x) . ,env) t-e))] 11 | [(fresh (rator rand t-x) 12 | (== `(,rator ,rand) exp) 13 | (!- rator env `(-> ,t-x ,t)) 14 | (!- rand env t-x))]))) 15 | 16 | (define lookupo 17 | (lambda (x env t) 18 | (fresh (rest y v) 19 | (== `((,y . ,v) . ,rest) env) 20 | (conde 21 | ((== y x) (== v t)) 22 | ((=/= y x) (lookupo x rest t)))))) 23 | 24 | (define not-in-envo 25 | (lambda (x env) 26 | (conde 27 | ((== '() env)) 28 | ((fresh (y v rest) 29 | (== `((,y . ,v) . ,rest) env) 30 | (=/= y x) 31 | (not-in-envo x rest)))))) 32 | 33 | (test "types" 34 | (run 10 (q) (fresh (t exp) (!- exp '() t) (== `(,exp => ,t) q))) 35 | '((((lambda (_.0) _.0) => (-> _.1 _.1)) (sym _.0)) 36 | (((lambda (_.0) (lambda (_.1) _.1)) 37 | => 38 | (-> _.2 (-> _.3 _.3))) 39 | (=/= ((_.0 lambda))) 40 | (sym _.0 _.1)) 41 | (((lambda (_.0) (lambda (_.1) _.0)) 42 | => 43 | (-> _.2 (-> _.3 _.2))) 44 | (=/= ((_.0 _.1)) ((_.0 lambda))) 45 | (sym _.0 _.1)) 46 | ((((lambda (_.0) _.0) (lambda (_.1) _.1)) => (-> _.2 _.2)) 47 | (sym _.0 _.1)) 48 | (((lambda (_.0) (lambda (_.1) (lambda (_.2) _.2))) 49 | => 50 | (-> _.3 (-> _.4 (-> _.5 _.5)))) 51 | (=/= ((_.0 lambda)) ((_.1 lambda))) 52 | (sym _.0 _.1 _.2)) 53 | (((lambda (_.0) (lambda (_.1) (lambda (_.2) _.1))) 54 | => 55 | (-> _.3 (-> _.4 (-> _.5 _.4)))) 56 | (=/= ((_.0 lambda)) ((_.1 _.2)) ((_.1 lambda))) 57 | (sym _.0 _.1 _.2)) 58 | (((lambda (_.0) (_.0 (lambda (_.1) _.1))) 59 | => 60 | (-> (-> (-> _.2 _.2) _.3) _.3)) 61 | (=/= ((_.0 lambda))) 62 | (sym _.0 _.1)) 63 | (((lambda (_.0) (lambda (_.1) (lambda (_.2) _.0))) 64 | => 65 | (-> _.3 (-> _.4 (-> _.5 _.3)))) 66 | (=/= ((_.0 _.1)) ((_.0 _.2)) ((_.0 lambda)) ((_.1 lambda))) 67 | (sym _.0 _.1 _.2)) 68 | (((lambda (_.0) (lambda (_.1) (_.1 _.0))) 69 | => 70 | (-> _.2 (-> (-> _.2 _.3) _.3))) 71 | (=/= ((_.0 _.1)) ((_.0 lambda))) 72 | (sym _.0 _.1)) 73 | ((((lambda (_.0) _.0) (lambda (_.1) (lambda (_.2) _.2))) 74 | => 75 | (-> _.3 (-> _.4 _.4))) 76 | (=/= ((_.1 lambda))) 77 | (sym _.0 _.1 _.2)))) 78 | -------------------------------------------------------------------------------- /test-interp.scm: -------------------------------------------------------------------------------- 1 | (define eval-expo 2 | (lambda (exp env val) 3 | (conde 4 | ((fresh (rator rand x body env^ a) 5 | (== `(,rator ,rand) exp) 6 | (eval-expo rator env `(closure ,x ,body ,env^)) 7 | (eval-expo rand env a) 8 | (eval-expo body `((,x . ,a) . ,env^) val))) 9 | ((fresh (x body) 10 | (== `(lambda (,x) ,body) exp) 11 | (symbolo x) 12 | (== `(closure ,x ,body ,env) val) 13 | (not-in-envo 'lambda env))) 14 | ((symbolo exp) (lookupo exp env val))))) 15 | 16 | (define not-in-envo 17 | (lambda (x env) 18 | (conde 19 | ((== '() env)) 20 | ((fresh (y v rest) 21 | (== `((,y . ,v) . ,rest) env) 22 | (=/= y x) 23 | (not-in-envo x rest)))))) 24 | 25 | (define lookupo 26 | (lambda (x env t) 27 | (conde 28 | ((fresh (y v rest) 29 | (== `((,y . ,v) . ,rest) env) (== y x) 30 | (== v t))) 31 | ((fresh (y v rest) 32 | (== `((,y . ,v) . ,rest) env) (=/= y x) 33 | (lookupo x rest t)))))) 34 | 35 | (test "running backwards" 36 | (run 5 (q) (eval-expo q '() '(closure y x ((x . (closure z z ())))))) 37 | '(((lambda (x) (lambda (y) x)) (lambda (z) z)) 38 | ((lambda (x) (x (lambda (y) x))) (lambda (z) z)) 39 | (((lambda (x) (lambda (y) x)) 40 | ((lambda (_.0) _.0) (lambda (z) z))) 41 | (sym _.0)) 42 | (((lambda (_.0) _.0) 43 | ((lambda (x) (lambda (y) x)) (lambda (z) z))) 44 | (sym _.0)) 45 | ((((lambda (_.0) _.0) (lambda (x) (lambda (y) x))) 46 | (lambda (z) z)) 47 | (sym _.0)))) 48 | 49 | (define lookupo 50 | (lambda (x env t) 51 | (fresh (rest y v) 52 | (== `((,y . ,v) . ,rest) env) 53 | (conde 54 | ((== y x) (== v t)) 55 | ((=/= y x) (lookupo x rest t)))))) 56 | 57 | (test "eval-exp-lc 1" 58 | (run* (q) (eval-expo '(((lambda (x) (lambda (y) x)) (lambda (z) z)) (lambda (a) a)) '() q)) 59 | '((closure z z ()))) 60 | 61 | (test "eval-exp-lc 2" 62 | (run* (q) (eval-expo '((lambda (x) (lambda (y) x)) (lambda (z) z)) '() q)) 63 | '((closure y x ((x . (closure z z ())))))) 64 | 65 | (test "running backwards" 66 | (run 5 (q) (eval-expo q '() '(closure y x ((x . (closure z z ())))))) 67 | '(((lambda (x) (lambda (y) x)) (lambda (z) z)) 68 | ((lambda (x) (x (lambda (y) x))) (lambda (z) z)) 69 | (((lambda (x) (lambda (y) x)) 70 | ((lambda (_.0) _.0) (lambda (z) z))) 71 | (sym _.0)) 72 | ((((lambda (_.0) _.0) (lambda (x) (lambda (y) x))) 73 | (lambda (z) z)) 74 | (sym _.0)) 75 | (((lambda (_.0) _.0) 76 | ((lambda (x) (lambda (y) x)) (lambda (z) z))) 77 | (sym _.0)))) 78 | 79 | (test "fully-running-backwards" 80 | (run 5 (q) 81 | (fresh (e v) 82 | (eval-expo e '() v) 83 | (== `(,e ==> ,v) q))) 84 | '((((lambda (_.0) _.1) 85 | ==> (closure _.0 _.1 ())) (sym _.0)) 86 | ((((lambda (_.0) _.0) (lambda (_.1) _.2)) 87 | ==> 88 | (closure _.1 _.2 ())) 89 | (sym _.0 _.1)) 90 | ((((lambda (_.0) (lambda (_.1) _.2)) (lambda (_.3) _.4)) 91 | ==> 92 | (closure _.1 _.2 ((_.0 . (closure _.3 _.4 ()))))) 93 | (=/= ((_.0 lambda))) 94 | (sym _.0 _.1 _.3)) 95 | ((((lambda (_.0) (_.0 _.0)) (lambda (_.1) _.1)) 96 | ==> 97 | (closure _.1 _.1 ())) 98 | (sym _.0 _.1)) 99 | ((((lambda (_.0) (_.0 _.0)) 100 | (lambda (_.1) (lambda (_.2) _.3))) 101 | ==> 102 | (closure _.2 _.3 ((_.1 . (closure _.1 (lambda (_.2) _.3) ()))))) 103 | (=/= ((_.1 lambda))) 104 | (sym _.0 _.1 _.2)))) 105 | 106 | 107 | -------------------------------------------------------------------------------- /test-numbers.scm: -------------------------------------------------------------------------------- 1 | (test "test 1" 2 | (run* (q) (*o (build-num 2) (build-num 3) q)) 3 | '((0 1 1))) 4 | 5 | (test "test 2" 6 | (run* (q) 7 | (fresh (n m) 8 | (*o n m (build-num 6)) 9 | (== `(,n ,m) q))) 10 | '(((1) (0 1 1)) ((0 1 1) (1)) ((0 1) (1 1)) ((1 1) (0 1)))) 11 | 12 | (test "sums" 13 | (run 5 (q) 14 | (fresh (x y z) 15 | (pluso x y z) 16 | (== `(,x ,y ,z) q))) 17 | '((_.0 () _.0) 18 | (() (_.0 . _.1) (_.0 . _.1)) 19 | ((1) (1) (0 1)) 20 | ((1) (0 _.0 . _.1) (1 _.0 . _.1)) 21 | ((1) (1 1) (0 0 1)))) 22 | 23 | (test "factors" 24 | (run* (q) 25 | (fresh (x y) 26 | (*o x y (build-num 24)) 27 | (== `(,x ,y ,(build-num 24)) q))) 28 | '(((1) (0 0 0 1 1) (0 0 0 1 1)) 29 | ((0 0 0 1 1) (1) (0 0 0 1 1)) 30 | ((0 1) (0 0 1 1) (0 0 0 1 1)) 31 | ((0 0 1) (0 1 1) (0 0 0 1 1)) 32 | ((0 0 0 1) (1 1) (0 0 0 1 1)) 33 | ((1 1) (0 0 0 1) (0 0 0 1 1)) 34 | ((0 1 1) (0 0 1) (0 0 0 1 1)) 35 | ((0 0 1 1) (0 1) (0 0 0 1 1)))) 36 | 37 | (define number-primo 38 | (lambda (exp env val) 39 | (fresh (n) 40 | (== `(intexp ,n) exp) 41 | (== `(intval ,n) val) 42 | (not-in-envo 'numo env)))) 43 | 44 | (define sub1-primo 45 | (lambda (exp env val) 46 | (fresh (e n n-1) 47 | (== `(sub1 ,e) exp) 48 | (== `(intval ,n-1) val) 49 | (not-in-envo 'sub1 env) 50 | (eval-expo e env `(intval ,n)) 51 | (minuso n '(1) n-1)))) 52 | 53 | (define zero?-primo 54 | (lambda (exp env val) 55 | (fresh (e n) 56 | (== `(zero? ,e) exp) 57 | (conde 58 | ((zeroo n) (== #t val)) 59 | ((poso n) (== #f val))) 60 | (not-in-envo 'zero? env) 61 | (eval-expo e env `(intval ,n))))) 62 | 63 | (define *-primo 64 | (lambda (exp env val) 65 | (fresh (e1 e2 n1 n2 n3) 66 | (== `(* ,e1 ,e2) exp) 67 | (== `(intval ,n3) val) 68 | (not-in-envo '* env) 69 | (eval-expo e1 env `(intval ,n1)) 70 | (eval-expo e2 env `(intval ,n2)) 71 | (*o n1 n2 n3)))) 72 | 73 | (define if-primo 74 | (lambda (exp env val) 75 | (fresh (e1 e2 e3 t) 76 | (== `(if ,e1 ,e2 ,e3) exp) 77 | (not-in-envo 'if env) 78 | (eval-expo e1 env t) 79 | (conde 80 | ((== #t t) (eval-expo e2 env val)) 81 | ((== #f t) (eval-expo e3 env val)))))) 82 | 83 | (define boolean-primo 84 | (lambda (exp env val) 85 | (conde 86 | ((== #t exp) (== #t val)) 87 | ((== #f exp) (== #f val))))) 88 | 89 | (define eval-expo 90 | (lambda (exp env val) 91 | (conde 92 | ((boolean-primo exp env val)) 93 | ((number-primo exp env val)) 94 | ((sub1-primo exp env val)) 95 | ((zero?-primo exp env val)) 96 | ((*-primo exp env val)) 97 | ((if-primo exp env val)) 98 | ((symbolo exp) (lookupo exp env val)) 99 | ((fresh (rator rand x body env^ a) 100 | (== `(,rator ,rand) exp) 101 | (eval-expo rator env `(closure ,x ,body ,env^)) 102 | (eval-expo rand env a) 103 | (eval-expo body `((,x . ,a) . ,env^) val))) 104 | ((fresh (x body) 105 | (== `(lambda (,x) ,body) exp) 106 | (symbolo x) 107 | (== `(closure ,x ,body ,env) val) 108 | (not-in-envo 'lambda env)))))) 109 | 110 | (define not-in-envo 111 | (lambda (x env) 112 | (conde 113 | ((fresh (y v rest) 114 | (== `((,y . ,v) . ,rest) env) 115 | (=/= y x) 116 | (not-in-envo x rest))) 117 | ((== '() env))))) 118 | 119 | (define lookupo 120 | (lambda (x env t) 121 | (fresh (rest y v) 122 | (== `((,y . ,v) . ,rest) env) 123 | (conde 124 | ((== y x) (== v t)) 125 | ((=/= y x) (lookupo x rest t)))))) 126 | 127 | (test "push-down problems 2" 128 | (run* (q) 129 | (fresh (x a d) 130 | (absento 'intval x) 131 | (== 'intval a) 132 | (== `(,a . ,d) x))) 133 | '()) 134 | 135 | (test "push-down problems 3" 136 | (run* (q) 137 | (fresh (x a d) 138 | (== `(,a . ,d) x) 139 | (absento 'intval x) 140 | (== 'intval a))) 141 | '()) 142 | 143 | (test "push-down problems 4" 144 | (run* (q) 145 | (fresh (x a d) 146 | (== `(,a . ,d) x) 147 | (== 'intval a) 148 | (absento 'intval x))) 149 | '()) 150 | 151 | (test "push-down problems 6" 152 | (run* (q) 153 | (fresh (x a d) 154 | (== 'intval a) 155 | (== `(,a . ,d) x) 156 | (absento 'intval x))) 157 | '()) 158 | 159 | (test "push-down problems 1" 160 | (run* (q) 161 | (fresh (x a d) 162 | (absento 'intval x) 163 | (== `(,a . ,d) x) 164 | (== 'intval a))) 165 | '()) 166 | 167 | (test "push-down problems 5" 168 | (run* (q) 169 | (fresh (x a d) 170 | (== 'intval a) 171 | (absento 'intval x) 172 | (== `(,a . ,d) x))) 173 | '()) 174 | 175 | (test "zero?" 176 | (run 1 (q) 177 | (eval-expo `(zero? (sub1 (intexp ,(build-num 1)))) '() q)) 178 | '(#t)) 179 | 180 | (test "*" 181 | (run 1 (q) 182 | (eval-expo `(* (intexp ,(build-num 3)) (intexp ,(build-num 2))) '() `(intval ,(build-num 6)))) 183 | '(_.0)) 184 | 185 | (test "sub1" 186 | (run 1 (q) 187 | (eval-expo q '() `(intval ,(build-num 6))) (== `(sub1 (intexp ,(build-num 7))) q)) 188 | '((sub1 (intexp (1 1 1))))) 189 | 190 | (test "sub1 bigger WAIT a minute" 191 | (run 1 (q) 192 | (eval-expo q '() `(intval ,(build-num 6))) 193 | (== `(sub1 (sub1 (intexp ,(build-num 8)))) q)) 194 | '((sub1 (sub1 (intexp (0 0 0 1)))))) 195 | 196 | (test "sub1 biggest WAIT a minute" 197 | (run 1 (q) 198 | (eval-expo q '() `(intval ,(build-num 6))) 199 | (== `(sub1 (sub1 (sub1 (intexp ,(build-num 9))))) q)) 200 | '((sub1 (sub1 (sub1 (intexp (1 0 0 1))))))) 201 | 202 | (test "lots of programs to make a 6" 203 | (run 12 (q) (eval-expo q '() `(intval ,(build-num 6)))) 204 | '((intexp (0 1 1)) (sub1 (intexp (1 1 1))) 205 | (* (intexp (1)) (intexp (0 1 1))) 206 | (* (intexp (0 1 1)) (intexp (1))) 207 | (if #t (intexp (0 1 1)) _.0) 208 | (* (intexp (0 1)) (intexp (1 1))) 209 | (if #f _.0 (intexp (0 1 1))) 210 | (sub1 (* (intexp (1)) (intexp (1 1 1)))) 211 | (((lambda (_.0) (intexp (0 1 1))) #t) 212 | (=/= ((_.0 numo))) 213 | (sym _.0)) 214 | (sub1 (* (intexp (1 1 1)) (intexp (1)))) 215 | (sub1 (sub1 (intexp (0 0 0 1)))) 216 | (sub1 (if #t (intexp (1 1 1)) _.0)))) 217 | 218 | (define rel-fact5 219 | `((lambda (f) 220 | ((f f) (intexp ,(build-num 5)))) 221 | (lambda (f) 222 | (lambda (n) 223 | (if (zero? n) 224 | (intexp ,(build-num 1)) 225 | (* n ((f f) (sub1 n)))))))) 226 | 227 | (test "rel-fact5" 228 | (run* (q) (eval-expo rel-fact5 '() q)) 229 | `((intval ,(build-num 120)))) 230 | 231 | (test "rel-fact5-backwards" 232 | (run 1 (q) 233 | (eval-expo 234 | `((lambda (f) 235 | ((f ,q) (intexp ,(build-num 5)))) 236 | (lambda (f) 237 | (lambda (n) 238 | (if (zero? n) 239 | (intexp ,(build-num 1)) 240 | (* n ((f f) (sub1 n))))))) 241 | '() 242 | `(intval ,(build-num 120)))) 243 | `(f)) 244 | -------------------------------------------------------------------------------- /test-quines.scm: -------------------------------------------------------------------------------- 1 | (define eval-expo 2 | (lambda (exp env val) 3 | (conde 4 | ((fresh (v) 5 | (== `(quote ,v) exp) 6 | (not-in-envo 'quote env) 7 | (absento 'closure v) 8 | (== v val))) 9 | ((fresh (a*) 10 | (== `(list . ,a*) exp) 11 | (not-in-envo 'list env) 12 | (absento 'closure a*) 13 | (proper-listo a* env val))) 14 | ((symbolo exp) (lookupo exp env val)) 15 | ((fresh (rator rand x body env^ a) 16 | (== `(,rator ,rand) exp) 17 | (eval-expo rator env `(closure ,x ,body ,env^)) 18 | (eval-expo rand env a) 19 | (eval-expo body `((,x . ,a) . ,env^) val))) 20 | ((fresh (x body) 21 | (== `(lambda (,x) ,body) exp) 22 | (symbolo x) 23 | (not-in-envo 'lambda env) 24 | (== `(closure ,x ,body ,env) val)))))) 25 | 26 | (define not-in-envo 27 | (lambda (x env) 28 | (conde 29 | ((fresh (y v rest) 30 | (== `((,y . ,v) . ,rest) env) 31 | (=/= y x) 32 | (not-in-envo x rest))) 33 | ((== '() env))))) 34 | 35 | (define proper-listo 36 | (lambda (exp env val) 37 | (conde 38 | ((== '() exp) 39 | (== '() val)) 40 | ((fresh (a d t-a t-d) 41 | (== `(,a . ,d) exp) 42 | (== `(,t-a . ,t-d) val) 43 | (eval-expo a env t-a) 44 | (proper-listo d env t-d)))))) 45 | 46 | (define lookupo 47 | (lambda (x env t) 48 | (fresh (rest y v) 49 | (== `((,y . ,v) . ,rest) env) 50 | (conde 51 | ((== y x) (== v t)) 52 | ((=/= y x) (lookupo x rest t)))))) 53 | 54 | (test "1 quine" 55 | (run 1 (q) (eval-expo q '() q)) 56 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 57 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 58 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 59 | (sym _.0)))) 60 | 61 | (test "2 quines" 62 | (run 2 (q) (eval-expo q '() q)) 63 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 64 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 65 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 66 | (sym _.0)) 67 | (((lambda (_.0) 68 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))) 69 | '(lambda (_.0) 70 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 71 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 72 | ((_.0 quote)) ((_.1 closure))) 73 | (sym _.0 _.1) 74 | (absento (closure _.2))))) 75 | 76 | (test "3 quines" 77 | (run 3 (q) (eval-expo q '() q)) 78 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 79 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 80 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 81 | (sym _.0)) 82 | (((lambda (_.0) 83 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))) 84 | '(lambda (_.0) 85 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 86 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 87 | ((_.0 quote)) ((_.1 closure))) 88 | (sym _.0 _.1) 89 | (absento (closure _.2))) 90 | (((lambda (_.0) 91 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))) 92 | '(lambda (_.0) 93 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))) 94 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 95 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 96 | (sym _.0 _.1) 97 | (absento (closure _.2))))) 98 | 99 | (test "5 quines" 100 | (run 5 (q) (eval-expo q '() q)) 101 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 102 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 103 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 104 | (sym _.0)) 105 | (((lambda (_.0) 106 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))) 107 | '(lambda (_.0) 108 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 109 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 110 | ((_.0 quote)) ((_.1 closure))) 111 | (sym _.0 _.1) 112 | (absento (closure _.2))) 113 | (((lambda (_.0) 114 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))) 115 | '(lambda (_.0) 116 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))) 117 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 118 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 119 | (sym _.0 _.1) 120 | (absento (closure _.2))) 121 | (((lambda (_.0) 122 | (list (list 'lambda '(_.0) _.0) (list 'quote _.0))) 123 | '(list (list 'lambda '(_.0) _.0) (list 'quote _.0))) 124 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 125 | (sym _.0)) 126 | (((lambda (_.0) 127 | (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0))) 128 | '(lambda (_.0) 129 | (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0)))) 130 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 131 | ((_.0 quote)) ((_.1 closure))) 132 | (sym _.0 _.1)))) 133 | 134 | (test "10 quines" 135 | (run 10 (q) (eval-expo q '() q)) 136 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 137 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 138 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 139 | (sym _.0)) 140 | (((lambda (_.0) 141 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))) 142 | '(lambda (_.0) 143 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 144 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 145 | ((_.0 quote)) ((_.1 closure))) 146 | (sym _.0 _.1) 147 | (absento (closure _.2))) 148 | (((lambda (_.0) 149 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))) 150 | '(lambda (_.0) 151 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))) 152 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 153 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 154 | (sym _.0 _.1) 155 | (absento (closure _.2))) 156 | (((lambda (_.0) 157 | (list (list 'lambda '(_.0) _.0) (list 'quote _.0))) 158 | '(list (list 'lambda '(_.0) _.0) (list 'quote _.0))) 159 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 160 | (sym _.0)) 161 | (((lambda (_.0) 162 | (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0))) 163 | '(lambda (_.0) 164 | (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0)))) 165 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 166 | ((_.0 quote)) ((_.1 closure))) 167 | (sym _.0 _.1)) 168 | (((lambda (_.0) 169 | ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2)) 170 | '(lambda (_.0) 171 | ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2))) 172 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 173 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 174 | (sym _.0 _.1) 175 | (absento (closure _.2))) 176 | (((lambda (_.0) 177 | (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2))) 178 | '(lambda (_.0) 179 | (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2)))) 180 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 181 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 182 | (sym _.0 _.1) 183 | (absento (closure _.2))) 184 | (((lambda (_.0) 185 | (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2)))) 186 | '(lambda (_.0) 187 | (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2))))) 188 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 189 | ((_.0 quote)) ((_.1 closure))) 190 | (sym _.0 _.1) 191 | (absento (closure _.2))) 192 | (((lambda (_.0) 193 | ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0)) 194 | '(lambda (_.0) 195 | ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0))) 196 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 197 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 198 | (sym _.0 _.1)) 199 | (((lambda (_.0) 200 | (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0))) 201 | '(lambda (_.0) 202 | (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0)))) 203 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 204 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 205 | (sym _.0 _.1)))) 206 | 207 | (test "40 quines" 208 | (run 40 (q) (eval-expo q '() q)) 209 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 210 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 211 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 212 | (sym _.0)) 213 | (((lambda (_.0) 214 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))) 215 | '(lambda (_.0) 216 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 217 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 218 | ((_.0 quote)) ((_.1 closure))) 219 | (sym _.0 _.1) 220 | (absento (closure _.2))) 221 | (((lambda (_.0) 222 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))) 223 | '(lambda (_.0) 224 | (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))) 225 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 226 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 227 | (sym _.0 _.1) 228 | (absento (closure _.2))) 229 | (((lambda (_.0) 230 | (list (list 'lambda '(_.0) _.0) (list 'quote _.0))) 231 | '(list (list 'lambda '(_.0) _.0) (list 'quote _.0))) 232 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 233 | (sym _.0)) 234 | (((lambda (_.0) 235 | (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0))) 236 | '(lambda (_.0) 237 | (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0)))) 238 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 239 | ((_.0 quote)) ((_.1 closure))) 240 | (sym _.0 _.1)) 241 | (((lambda (_.0) 242 | ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2)) 243 | '(lambda (_.0) 244 | ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2))) 245 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 246 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 247 | (sym _.0 _.1) 248 | (absento (closure _.2))) 249 | (((lambda (_.0) 250 | (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2))) 251 | '(lambda (_.0) 252 | (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2)))) 253 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 254 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 255 | (sym _.0 _.1) 256 | (absento (closure _.2))) 257 | (((lambda (_.0) 258 | (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2)))) 259 | '(lambda (_.0) 260 | (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2))))) 261 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 262 | ((_.0 quote)) ((_.1 closure))) 263 | (sym _.0 _.1) 264 | (absento (closure _.2))) 265 | (((lambda (_.0) 266 | ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0)) 267 | '(lambda (_.0) 268 | ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0))) 269 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 270 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 271 | (sym _.0 _.1)) 272 | (((lambda (_.0) 273 | (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0))) 274 | '(lambda (_.0) 275 | (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0)))) 276 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 277 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 278 | (sym _.0 _.1)) 279 | (((lambda (_.0) 280 | ((lambda (_.1) (list _.0 (list _.1 _.0))) 'quote)) 281 | '(lambda (_.0) 282 | ((lambda (_.1) (list _.0 (list _.1 _.0))) 'quote))) 283 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 284 | ((_.0 quote)) ((_.1 closure)) ((_.1 list))) 285 | (sym _.0 _.1)) 286 | (((lambda (_.0) 287 | (list _.0 ((lambda (_.1) (list _.1 _.0)) 'quote))) 288 | '(lambda (_.0) 289 | (list _.0 ((lambda (_.1) (list _.1 _.0)) 'quote)))) 290 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 291 | ((_.0 quote)) ((_.1 closure)) ((_.1 list))) 292 | (sym _.0 _.1)) 293 | (((lambda (_.0) 294 | (list _.0 (list 'quote ((lambda (_.1) _.1) _.0)))) 295 | '(lambda (_.0) 296 | (list _.0 (list 'quote ((lambda (_.1) _.1) _.0))))) 297 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 298 | ((_.0 quote)) ((_.1 closure))) 299 | (sym _.0 _.1)) 300 | (((lambda (_.0) 301 | (list 302 | ((lambda (_.1) _.0) '_.2) 303 | (list ((lambda (_.3) 'quote) '_.4) _.0))) 304 | '(lambda (_.0) 305 | (list 306 | ((lambda (_.1) _.0) '_.2) 307 | (list ((lambda (_.3) 'quote) '_.4) _.0)))) 308 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 309 | ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) ((_.3 quote))) 310 | (sym _.0 _.1 _.3) 311 | (absento (closure _.2) (closure _.4))) 312 | (((lambda (_.0) 313 | (list ((lambda (_.1) _.1) _.0) (list 'quote _.0))) 314 | '(lambda (_.0) 315 | (list ((lambda (_.1) _.1) _.0) (list 'quote _.0)))) 316 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 317 | ((_.0 quote)) ((_.1 closure))) 318 | (sym _.0 _.1)) 319 | (((lambda (_.0) 320 | (list _.0 (list 'quote ((lambda (_.1) _.0) _.0)))) 321 | '(lambda (_.0) 322 | (list _.0 (list 'quote ((lambda (_.1) _.0) _.0))))) 323 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 324 | ((_.0 quote)) ((_.1 closure))) 325 | (sym _.0 _.1)) 326 | (((lambda (_.0) 327 | (list _.0 ((lambda (_.1) (list 'quote _.0)) _.0))) 328 | '(lambda (_.0) 329 | (list _.0 ((lambda (_.1) (list 'quote _.0)) _.0)))) 330 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 331 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 332 | (sym _.0 _.1)) 333 | (((lambda (_.0) 334 | ((lambda (_.1) (list _.1 (list 'quote _.0))) _.0)) 335 | '(lambda (_.0) 336 | ((lambda (_.1) (list _.1 (list 'quote _.0))) _.0))) 337 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 338 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 339 | (sym _.0 _.1)) 340 | (((lambda (_.0) 341 | (list _.0 (list ((lambda (_.1) 'quote) _.0) _.0))) 342 | '(lambda (_.0) 343 | (list _.0 (list ((lambda (_.1) 'quote) _.0) _.0)))) 344 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 345 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 346 | (sym _.0 _.1)) 347 | (((lambda (_.0) 348 | (list 349 | ((lambda (_.1) _.0) '_.2) 350 | (list ((lambda (_.3) _.3) 'quote) _.0))) 351 | '(lambda (_.0) 352 | (list 353 | ((lambda (_.1) _.0) '_.2) 354 | (list ((lambda (_.3) _.3) 'quote) _.0)))) 355 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 356 | ((_.0 quote)) ((_.1 closure)) ((_.3 closure))) 357 | (sym _.0 _.1 _.3) 358 | (absento (closure _.2))) 359 | (((lambda (_.0) 360 | (list 361 | ((lambda (_.1) _.0) '_.2) 362 | ((lambda (_.3) (list 'quote _.0)) '_.4))) 363 | '(lambda (_.0) 364 | (list 365 | ((lambda (_.1) _.0) '_.2) 366 | ((lambda (_.3) (list 'quote _.0)) '_.4)))) 367 | (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) 368 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) 369 | ((_.3 list)) ((_.3 quote))) 370 | (sym _.0 _.1 _.3) 371 | (absento (closure _.2) (closure _.4))) 372 | (((lambda (_.0) 373 | (list 374 | ((lambda (_.1) _.0) '_.2) 375 | (list 'quote ((lambda (_.3) _.0) '_.4)))) 376 | '(lambda (_.0) 377 | (list 378 | ((lambda (_.1) _.0) '_.2) 379 | (list 'quote ((lambda (_.3) _.0) '_.4))))) 380 | (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) 381 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure))) 382 | (sym _.0 _.1 _.3) 383 | (absento (closure _.2) (closure _.4))) 384 | (((lambda (_.0) 385 | (list 386 | _.0 387 | (list 388 | ((lambda (_.1) 'quote) '_.2) 389 | ((lambda (_.3) _.0) '_.4)))) 390 | '(lambda (_.0) 391 | (list 392 | _.0 393 | (list 394 | ((lambda (_.1) 'quote) '_.2) 395 | ((lambda (_.3) _.0) '_.4))))) 396 | (=/= ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 397 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote)) ((_.3 closure))) 398 | (sym _.0 _.1 _.3) 399 | (absento (closure _.2) (closure _.4))) 400 | (((lambda (_.0) 401 | ((lambda (_.1) (list _.0 (list 'quote _.1))) _.0)) 402 | '(lambda (_.0) 403 | ((lambda (_.1) (list _.0 (list 'quote _.1))) _.0))) 404 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 405 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 406 | (sym _.0 _.1)) 407 | (((lambda (_.0) 408 | (list _.0 (list 'quote ((lambda (_.1) _.0) (list))))) 409 | '(lambda (_.0) 410 | (list _.0 (list 'quote ((lambda (_.1) _.0) (list)))))) 411 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 412 | ((_.0 quote)) ((_.1 closure))) 413 | (sym _.0 _.1)) 414 | (((lambda (_.0) 415 | (list 416 | (list 'lambda '(_.0) _.0) 417 | (list ((lambda (_.1) 'quote) '_.2) _.0))) 418 | '(list 419 | (list 'lambda '(_.0) _.0) 420 | (list ((lambda (_.1) 'quote) '_.2) _.0))) 421 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 422 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 423 | (sym _.0 _.1) 424 | (absento (closure _.2))) 425 | (((lambda (_.0) 426 | ((lambda (_.1) 427 | (list ((lambda (_.2) _.0) '_.3) (list 'quote _.0))) 428 | '_.4)) 429 | '(lambda (_.0) 430 | ((lambda (_.1) 431 | (list ((lambda (_.2) _.0) '_.3) (list 'quote _.0))) 432 | '_.4))) 433 | (=/= ((_.0 _.1)) ((_.0 _.2)) ((_.0 closure)) ((_.0 lambda)) 434 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.1 lambda)) 435 | ((_.1 list)) ((_.1 quote)) ((_.2 closure))) 436 | (sym _.0 _.1 _.2) 437 | (absento (closure _.3) (closure _.4))) 438 | (((lambda (_.0) 439 | (list 440 | ((lambda (_.1) _.0) '_.2) 441 | ((lambda (_.3) (list 'quote _.3)) _.0))) 442 | '(lambda (_.0) 443 | (list 444 | ((lambda (_.1) _.0) '_.2) 445 | ((lambda (_.3) (list 'quote _.3)) _.0)))) 446 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 447 | ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) ((_.3 list)) 448 | ((_.3 quote))) 449 | (sym _.0 _.1 _.3) 450 | (absento (closure _.2))) 451 | (((lambda (_.0) 452 | (list 453 | ((lambda (_.1) _.0) '_.2) 454 | ((lambda (_.3) (list _.3 _.0)) 'quote))) 455 | '(lambda (_.0) 456 | (list 457 | ((lambda (_.1) _.0) '_.2) 458 | ((lambda (_.3) (list _.3 _.0)) 'quote)))) 459 | (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) 460 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) 461 | ((_.3 list))) 462 | (sym _.0 _.1 _.3) 463 | (absento (closure _.2))) 464 | (((lambda (_.0) 465 | (list 466 | ((lambda (_.1) _.0) '_.2) 467 | (list 'quote ((lambda (_.3) _.3) _.0)))) 468 | '(lambda (_.0) 469 | (list 470 | ((lambda (_.1) _.0) '_.2) 471 | (list 'quote ((lambda (_.3) _.3) _.0))))) 472 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 473 | ((_.0 quote)) ((_.1 closure)) ((_.3 closure))) 474 | (sym _.0 _.1 _.3) 475 | (absento (closure _.2))) 476 | (((lambda (_.0) 477 | (list _.0 ((lambda (_.1) (list 'quote _.0)) (list)))) 478 | '(lambda (_.0) 479 | (list _.0 ((lambda (_.1) (list 'quote _.0)) (list))))) 480 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 481 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 482 | (sym _.0 _.1)) 483 | (((lambda (_.0) 484 | (list 485 | _.0 486 | (list 487 | ((lambda (_.1) 'quote) '_.2) 488 | ((lambda (_.3) _.3) _.0)))) 489 | '(lambda (_.0) 490 | (list 491 | _.0 492 | (list 493 | ((lambda (_.1) 'quote) '_.2) 494 | ((lambda (_.3) _.3) _.0))))) 495 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 496 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote)) ((_.3 closure))) 497 | (sym _.0 _.1 _.3) 498 | (absento (closure _.2))) 499 | (((lambda (_.0) 500 | ((lambda (_.1) (list _.0 (list 'quote _.0))) (list))) 501 | '(lambda (_.0) 502 | ((lambda (_.1) (list _.0 (list 'quote _.0))) (list)))) 503 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 504 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 505 | (sym _.0 _.1)) 506 | (((lambda (_.0) 507 | (list ((lambda (_.1) _.0) _.0) (list 'quote _.0))) 508 | '(lambda (_.0) 509 | (list ((lambda (_.1) _.0) _.0) (list 'quote _.0)))) 510 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 511 | ((_.0 quote)) ((_.1 closure))) 512 | (sym _.0 _.1)) 513 | (((lambda (_.0) 514 | (list 515 | (list 'lambda '(_.0) _.0) 516 | (list ((lambda (_.1) _.1) 'quote) _.0))) 517 | '(list 518 | (list 'lambda '(_.0) _.0) 519 | (list ((lambda (_.1) _.1) 'quote) _.0))) 520 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 521 | ((_.0 quote)) ((_.1 closure))) 522 | (sym _.0 _.1)) 523 | (((lambda (_.0) 524 | ((lambda (_.1) (list _.0 (list 'quote _.0))) _.0)) 525 | '(lambda (_.0) 526 | ((lambda (_.1) (list _.0 (list 'quote _.0))) _.0))) 527 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 528 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 529 | (sym _.0 _.1)) 530 | (((lambda (_.0) 531 | (list 532 | (list 'lambda '(_.0) _.0) 533 | ((lambda (_.1) (list 'quote _.0)) '_.2))) 534 | '(list 535 | (list 'lambda '(_.0) _.0) 536 | ((lambda (_.1) (list 'quote _.0)) '_.2))) 537 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 538 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 539 | (sym _.0 _.1) 540 | (absento (closure _.2))) 541 | (((lambda (_.0) 542 | (list 543 | ((lambda (_.1) _.0) '_.2) 544 | (list 'quote ((lambda (_.3) _.0) _.0)))) 545 | '(lambda (_.0) 546 | (list 547 | ((lambda (_.1) _.0) '_.2) 548 | (list 'quote ((lambda (_.3) _.0) _.0))))) 549 | (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) 550 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure))) 551 | (sym _.0 _.1 _.3) 552 | (absento (closure _.2))) 553 | (((lambda (_.0) 554 | (list 555 | ((lambda (_.1) _.0) '_.2) 556 | ((lambda (_.3) (list 'quote _.0)) _.0))) 557 | '(lambda (_.0) 558 | (list 559 | ((lambda (_.1) _.0) '_.2) 560 | ((lambda (_.3) (list 'quote _.0)) _.0)))) 561 | (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) 562 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) 563 | ((_.3 list)) ((_.3 quote))) 564 | (sym _.0 _.1 _.3) 565 | (absento (closure _.2))) 566 | (((lambda (_.0) 567 | ((lambda (_.1) 568 | (list ((lambda (_.2) _.0) '_.3) (list _.1 _.0))) 569 | 'quote)) 570 | '(lambda (_.0) 571 | ((lambda (_.1) 572 | (list ((lambda (_.2) _.0) '_.3) (list _.1 _.0))) 573 | 'quote))) 574 | (=/= ((_.0 _.1)) ((_.0 _.2)) ((_.0 closure)) ((_.0 lambda)) 575 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.1 lambda)) 576 | ((_.1 list)) ((_.1 quote)) ((_.2 closure))) 577 | (sym _.0 _.1 _.2) 578 | (absento (closure _.3))))) 579 | 580 | (test "2 twines" 581 | (run 2 (x) (fresh (p q) 582 | (=/= p q) 583 | (eval-expo p '() q) 584 | (eval-expo q '() p) 585 | (== `(,p ,q) x))) 586 | '((('((lambda (_.0) 587 | (list 'quote (list _.0 (list 'quote _.0)))) 588 | '(lambda (_.0) (list 'quote (list _.0 (list 'quote _.0))))) 589 | ((lambda (_.0) (list 'quote (list _.0 (list 'quote _.0)))) 590 | '(lambda (_.0) (list 'quote (list _.0 (list 'quote _.0)))))) 591 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 592 | (sym _.0)) 593 | (('((lambda (_.0) 594 | (list 595 | 'quote 596 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 597 | '(lambda (_.0) 598 | (list 599 | 'quote 600 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))) 601 | ((lambda (_.0) 602 | (list 603 | 'quote 604 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))) 605 | '(lambda (_.0) 606 | (list 607 | 'quote 608 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))) 609 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 610 | ((_.0 quote)) ((_.1 closure))) 611 | (sym _.0 _.1) 612 | (absento (closure _.2))))) 613 | 614 | (test "4 thrines" 615 | (run 4 (x) 616 | (fresh (p q r) 617 | (=/= p q) 618 | (=/= q r) 619 | (=/= r p) 620 | (eval-expo p '() q) 621 | (eval-expo q '() r) 622 | (eval-expo r '() p) 623 | (== `(,p ,q ,r) x))) 624 | '(((''((lambda (_.0) 625 | (list 'quote (list 'quote (list _.0 (list 'quote _.0))))) 626 | '(lambda (_.0) 627 | (list 'quote (list 'quote (list _.0 (list 'quote _.0)))))) 628 | '((lambda (_.0) 629 | (list 'quote (list 'quote (list _.0 (list 'quote _.0))))) 630 | '(lambda (_.0) 631 | (list 'quote (list 'quote (list _.0 (list 'quote _.0)))))) 632 | ((lambda (_.0) 633 | (list 'quote (list 'quote (list _.0 (list 'quote _.0))))) 634 | '(lambda (_.0) 635 | (list 'quote (list 'quote (list _.0 (list 'quote _.0))))))) 636 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 637 | (sym _.0)) 638 | ((''((lambda (_.0) 639 | (list 640 | 'quote 641 | (list 642 | 'quote 643 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))) 644 | '(lambda (_.0) 645 | (list 646 | 'quote 647 | (list 648 | 'quote 649 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))) 650 | '((lambda (_.0) 651 | (list 652 | 'quote 653 | (list 654 | 'quote 655 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))) 656 | '(lambda (_.0) 657 | (list 658 | 'quote 659 | (list 660 | 'quote 661 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))) 662 | ((lambda (_.0) 663 | (list 664 | 'quote 665 | (list 666 | 'quote 667 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))) 668 | '(lambda (_.0) 669 | (list 670 | 'quote 671 | (list 672 | 'quote 673 | (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))))) 674 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 675 | ((_.0 quote)) ((_.1 closure))) 676 | (sym _.0 _.1) 677 | (absento (closure _.2))) 678 | (('(list 679 | '(lambda (_.0) 680 | (list 681 | 'quote 682 | (list 'list _.0 (list 'quote (list 'quote _.0))))) 683 | '''(lambda (_.0) 684 | (list 685 | 'quote 686 | (list 'list _.0 (list 'quote (list 'quote _.0)))))) 687 | (list 688 | '(lambda (_.0) 689 | (list 690 | 'quote 691 | (list 'list _.0 (list 'quote (list 'quote _.0))))) 692 | '''(lambda (_.0) 693 | (list 694 | 'quote 695 | (list 'list _.0 (list 'quote (list 'quote _.0)))))) 696 | ((lambda (_.0) 697 | (list 698 | 'quote 699 | (list 'list _.0 (list 'quote (list 'quote _.0))))) 700 | ''(lambda (_.0) 701 | (list 702 | 'quote 703 | (list 'list _.0 (list 'quote (list 'quote _.0))))))) 704 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 705 | (sym _.0)) 706 | ((''((lambda (_.0) 707 | (list 708 | ((lambda (_.1) 'quote) '_.2) 709 | (list 'quote (list _.0 (list 'quote _.0))))) 710 | '(lambda (_.0) 711 | (list 712 | ((lambda (_.1) 'quote) '_.2) 713 | (list 'quote (list _.0 (list 'quote _.0)))))) 714 | '((lambda (_.0) 715 | (list 716 | ((lambda (_.1) 'quote) '_.2) 717 | (list 'quote (list _.0 (list 'quote _.0))))) 718 | '(lambda (_.0) 719 | (list 720 | ((lambda (_.1) 'quote) '_.2) 721 | (list 'quote (list _.0 (list 'quote _.0)))))) 722 | ((lambda (_.0) 723 | (list 724 | ((lambda (_.1) 'quote) '_.2) 725 | (list 'quote (list _.0 (list 'quote _.0))))) 726 | '(lambda (_.0) 727 | (list 728 | ((lambda (_.1) 'quote) '_.2) 729 | (list 'quote (list _.0 (list 'quote _.0))))))) 730 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 731 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 732 | (sym _.0 _.1) 733 | (absento (closure _.2))))) 734 | --------------------------------------------------------------------------------