[ { "path": "==-tests.scm", "content": "(test \"1\"\n (run 1 (q) (== 5 q))\n '(5))\n\n(test \"2\"\n (run* (q)\n (conde\n [(== 5 q)]\n [(== 6 q)]))\n '(5 6))\n\n(test \"3\"\n (run* (q)\n (fresh (a d)\n (conde\n [(== 5 a)]\n [(== 6 d)])\n (== `(,a . ,d) q)))\n '((5 . _.0) (_.0 . 6)))\n\n(define appendo\n (lambda (l s out)\n (conde\n [(== '() l) (== s out)]\n [(fresh (a d res)\n (== `(,a . ,d) l)\n (== `(,a . ,res) out)\n (appendo d s res))])))\n\n(test \"4\"\n (run* (q) (appendo '(a b c) '(d e) q))\n '((a b c d e)))\n\n(test \"5\"\n (run* (q) (appendo q '(d e) '(a b c d e)))\n '((a b c)))\n\n(test \"6\"\n (run* (q) (appendo '(a b c) q '(a b c d e)))\n '((d e)))\n\n(test \"7\"\n (run 5 (q)\n (fresh (l s out) \n (appendo l s out)\n (== `(,l ,s ,out) q)))\n '((() _.0 _.0)\n ((_.0) _.1 (_.0 . _.1))\n ((_.0 _.1) _.2 (_.0 _.1 . _.2))\n ((_.0 _.1 _.2) _.3 (_.0 _.1 _.2 . _.3))\n ((_.0 _.1 _.2 _.3) _.4 (_.0 _.1 _.2 _.3 . _.4))))\n" }, { "path": "LICENSE", "content": "The MIT License (MIT)\n\nCopyright (c) 2015 William E. Byrd\n\nPermission is hereby granted, free of charge, to any person obtaining a copy\nof this software and associated documentation files (the \"Software\"), to deal\nin the Software without restriction, including without limitation the rights\nto use, copy, modify, merge, publish, distribute, sublicense, and/or sell\ncopies of the Software, and to permit persons to whom the Software is\nfurnished to do so, subject to the following conditions:\n\nThe above copyright notice and this permission notice shall be included in all\ncopies or substantial portions of the Software.\n\nTHE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR\nIMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,\nFITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE\nAUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER\nLIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,\nOUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE\nSOFTWARE.\n\n" }, { "path": "README.md", "content": "# miniKanren-with-symbolic-constraints\n\nThe version of miniKanren I normally use. Includes `==`, `=/=`, `symbolo`, `numbero`, generalized `absento` constraints.\n\nGood for writing Quine-generating interpreters, etc. :)\n\nAlso includes `eigen`, which represents universally quanitifed variables. Beware: this implementation does *not* support use of `eigen` with constraints other than `==`.\n\nAlso includes multi-query variable version of `run`.\nFor example, `(run (q r s) (== (cons r q) s))`.\n\n## Running\n\n### Chez and Vicare\n\n```\n(load \"mk.scm\")\n```\n\n### Racket\n\n```\n(require \"mk.rkt\")\n```\n\n### Guile\n\n```\n(load \"mk-guile.scm\")\n```\n\n### Chicken\n\n```\n(load \"mk-chicken.scm\")\n```\n\n## Running Tests\n\nAfter loading miniKanren as above,\n\n```\n(load \"test-all.scm\")\n```\n\nregardless of scheme implementation.\n" }, { "path": "absento-closure-tests.scm", "content": "(test \"absento 'closure-1a\"\n (run* (q) (absento 'closure q) (== q 'closure))\n '())\n\n(test \"absento 'closure-1b\"\n (run* (q) (== q 'closure) (absento 'closure q))\n '())\n\n(test \"absento 'closure-2a\"\n (run* (q) (fresh (a d) (== q 'closure) (absento 'closure q)))\n '())\n\n(test \"absento 'closure-2b\"\n (run* (q) (fresh (a d) (absento 'closure q) (== q 'closure)))\n '())\n\n(test \"absento 'closure-3a\"\n (run* (q) (fresh (a d) (absento 'closure q) (== `(,a . ,d) q)))\n '(((_.0 . _.1) (absento (closure _.0) (closure _.1)))))\n\n(test \"absento 'closure-3b\"\n (run* (q) (fresh (a d) (== `(,a . ,d) q) (absento 'closure q))) \n '(((_.0 . _.1) (absento (closure _.0) (closure _.1)))))\n\n(test \"absento 'closure-4a\"\n (run* (q) (fresh (a d) (absento 'closure q) (== `(,a . ,d) q) (== 'closure a)))\n '())\n\n(test \"absento 'closure-4b\"\n (run* (q) (fresh (a d) (absento 'closure q) (== 'closure a) (== `(,a . ,d) q)))\n '())\n\n(test \"absento 'closure-4c\"\n (run* (q) (fresh (a d) (== 'closure a) (absento 'closure q) (== `(,a . ,d) q)))\n '())\n\n(test \"absento 'closure-4d\"\n (run* (q) (fresh (a d) (== 'closure a) (== `(,a . ,d) q) (absento 'closure q)))\n '())\n\n(test \"absento 'closure-5a\"\n (run* (q) (fresh (a d) (absento 'closure q) (== `(,a . ,d) q) (== 'closure d)))\n '())\n\n(test \"absento 'closure-5b\"\n (run* (q) (fresh (a d) (absento 'closure q) (== 'closure d) (== `(,a . ,d) q)))\n '())\n\n(test \"absento 'closure-5c\"\n (run* (q) (fresh (a d) (== 'closure d) (absento 'closure q) (== `(,a . ,d) q)))\n '())\n\n(test \"absento 'closure-5d\"\n (run* (q) (fresh (a d) (== 'closure d) (== `(,a . ,d) q) (absento 'closure q)))\n '())\n\n(test \"absento 'closure-6\"\n (run* (q)\n (== `(3 (closure x (x x) ((y . 7))) #t) q)\n (absento 'closure q))\n '())\n" }, { "path": "absento-tests.scm", "content": "(test \"test 0\"\n (run* (q) (absento q q))\n '())\n\n(test \"test 1\"\n (run* (q)\n (fresh (a b c)\n (== a b)\n (absento b c)\n (== c b)\n (== `(,a ,b ,c) q)))\n '())\n\n(test \"test 2\"\n (run* (q)\n (fresh (a)\n (absento q a)\n (absento `((,q ,q) 3 (,q ,q)) `(,a 3 ,a))))\n '(_.0))\n\n(test \"test 3\"\n (run* (q)\n (fresh (a b)\n (absento q a)\n (absento `(3 ,a) `(,b ,a))\n (== 3 b)))\n '())\n\n(test \"test 4\"\n (run* (q)\n (fresh (a b)\n (absento q a)\n (absento `(3 ,a) `(,q ,a))\n (== 3 b)))\n '((_.0 (=/= ((_.0 3))))))\n\n(test \"test 5\"\n (run* (q)\n (fresh (a b)\n (numbero a)\n (numbero b)\n (absento '(3 3) `(,a ,b))\n (=/= a b)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (=/= ((_.0 _.1))) (num _.0 _.1))))\n\n(test \"test 6\"\n (run* (q) (fresh (a) (absento q a) (== q a)))\n '())\n\n(test \"test 7\"\n (run* (q)\n (fresh (a b c)\n (absento '(3 . 4) c)\n (== `(,a . ,b) c)\n (== q `(,a . ,b))))\n '(((_.0 . _.1) (=/= ((_.0 3) (_.1 4))) (absento ((3 . 4) _.0) ((3 . 4) _.1)))))\n\n(test \"test 8\"\n (run* (q)\n (fresh (a b)\n (absento 5 a)\n (symbolo b)\n (== `(,q ,b) a)))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 9\"\n (run* (q)\n (fresh (a b)\n (absento 5 a)\n (== `(,q ,b) a)))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 10\"\n (run* (q) (fresh (a) (absento `(3 . ,a) q) (absento q `(3 . ,a))))\n '((_.0 (=/= ((_.0 3))))))\n\n(test \"test 11\"\n (run* (q)\n (fresh (a b c d e f)\n (absento `(,a . ,b) q)\n (absento q `(,a . ,b))\n (== `(,c . ,d) a)\n (== `(3 . ,e) c)\n (== `(,f . 4) d)))\n '((_.0 (=/= ((_.0 3)) ((_.0 4))))))\n\n(test \"test 12\"\n (run* (q)\n (fresh (a b c)\n (absento `(,3 . ,a) `(,b . ,c))\n (numbero b)\n (== `(,a ,b ,c) q)))\n '(((_.0 _.1 _.2) (=/= ((_.0 _.2) (_.1 3))) (num _.1) (absento ((3 . _.0) _.2)))))\n\n(test \"test 13\"\n (run* (q)\n (fresh (a b c)\n (== `(,a . ,b) q)\n (absento '(3 . 4) q)\n (numbero a)\n (numbero b)))\n '(((_.0 . _.1) (=/= ((_.0 3) (_.1 4))) (num _.0 _.1))))\n\n(test \"test 14\"\n (run* (q)\n (fresh (a b)\n (absento '(3 . 4) `(,a . ,b))\n (== `(,a . ,b) q)))\n '(((_.0 . _.1) (=/= ((_.0 3) (_.1 4))) (absento ((3 . 4) _.0) ((3 . 4) _.1)))))\n\n(test \"test 15\"\n (run* (q)\n (absento q `(3 . (4 . 5))))\n '((_.0 (=/= ((_.0 3))\n ((_.0 4))\n ((_.0 5))\n ((_.0 (3 . (4 . 5))))\n ((_.0 (4 . 5)))))))\n\n(test \"test 16\"\n (run* (q)\n (fresh (a b x)\n (absento a b)\n (symbolo a)\n (numbero x)\n (== x b)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n(test \"test 19\"\n (run* (q) (absento 5 q) (absento 5 q))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 20\"\n (run* (q) (absento 5 q) (absento 6 q))\n '((_.0 (absento (5 _.0) (6 _.0)))))\n\n(test \"test 21\"\n (run* (q) (absento 5 q) (symbolo q))\n '((_.0 (sym _.0))))\n\n(test \"test 22\"\n (run* (q) (numbero q) (absento 'tag q))\n '((_.0 (num _.0))))\n\n(test \"test 23\"\n (run* (q) (absento 'tag q) (numbero q))\n '((_.0 (num _.0))))\n\n(test \"test 24\"\n (run* (q) (== 5 q) (absento 5 q))\n '())\n\n(test \"test 25\"\n (run* (q) (== q `(5 6)) (absento 5 q))\n '())\n\n(test \"test 25b\"\n (run* (q) (absento 5 q) (== q `(5 6)))\n '())\n\n(test \"test 26\"\n (run* (q) (absento 5 q) (== 5 q))\n '())\n\n(test \"test 27\"\n (run* (q) (absento 'tag1 q) (absento 'tag2 q))\n '((_.0 (absento (tag1 _.0) (tag2 _.0)))))\n\n(test \"test 28\"\n (run* (q) (absento 'tag q) (numbero q))\n '((_.0 (num _.0))))\n\n(test \"test 29\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)\n (symbolo a)\n (numbero b)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n(test \"test 30\"\n (run* (q)\n (fresh (a b)\n (absento b a)\n (absento a b)\n (== `(,a ,b) q)\n (symbolo a)\n (symbolo b)))\n '(((_.0 _.1) (=/= ((_.0 _.1))) (sym _.0 _.1))))\n\n(test \"test 31\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (absento (_.0 _.1) (_.1 _.0)))))\n\n(test \"test 32\"\n (run* (q)\n (fresh (a b)\n (absento 5 a)\n (absento 5 b)\n (== `(,a . ,b) q)))\n '(((_.0 . _.1) (absento (5 _.0) (5 _.1)))))\n\n(test \"test 33\"\n (run* (q)\n (fresh (a b c)\n (== `(,a ,b) c)\n (== `(,c ,c) q)\n (symbolo b)\n (numbero c)))\n '())\n\n(test \"test 34\"\n (run* (q) (absento 'tag q) (symbolo q))\n '((_.0 (=/= ((_.0 tag))) (sym _.0))))\n\n(test \"test 35\"\n (run* (q) (absento 5 q) (numbero q))\n '((_.0 (=/= ((_.0 5))) (num _.0))))\n\n(test \"test 36\"\n (run* (q)\n (fresh (a)\n (== 5 a) (absento a q)))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 37\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)\n (symbolo a)\n (symbolo b)))\n '(((_.0 _.1) (=/= ((_.0 _.1))) (sym _.0 _.1))))\n\n(test \"test 38\"\n (run* (q) (absento '() q))\n '((_.0 (absento (() _.0)))))\n\n(test \"test 39\"\n (run* (q) (absento `(3 4) q))\n '((_.0 (absento ((3 4) _.0)))))\n\n(test \"test 40\"\n (run* (q)\n (fresh (d a c)\n (== `(3 . ,d) q)\n (=/= `(,c . ,a) q)\n (== '(3 . 4) d)))\n '((3 3 . 4)))\n\n(test \"test 41\"\n (run* (q)\n (fresh (a)\n (== `(,a . ,a) q)))\n '((_.0 . _.0)))\n\n(test \"test 42\"\n (run* (q)\n (fresh (a b)\n (== `((3 4) (5 6)) q)\n (absento `(3 4) q)))\n '())\n\n(test \"test 43\"\n (run* (q) (absento q 3))\n '((_.0 (=/= ((_.0 3))))))\n\n(test \"test 44\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (absento (_.0 _.1) (_.1 _.0)))))\n\n(test \"test 45\"\n (run* (q)\n (fresh (a b)\n (absento `(,a . ,b) q)\n (== q `(3 . (,b . ,b)))))\n '((3 _.0 . _.0)))\n\n(test \"test 45b\"\n (run* (q)\n (fresh (a b)\n (absento `(,a . ,b) q)\n (== q `(,a 3 . (,b . ,b)))))\n '(((_.0 3 _.1 . _.1) (=/= ((_.0 _.1))))))\n\n(test \"test 46\"\n (run* (q)\n (fresh (a)\n (absento a q)\n (absento q a)))\n '(_.0))\n\n(test \"test 47\"\n (run* (q)\n (fresh (a)\n (absento `(,a . 3) q)))\n '(_.0)) \n\n(test \"test 48\"\n (run* (q)\n (fresh (a)\n (absento `(,a . 3) q)))\n '(_.0))\n\n(test \"test 49\"\n (run* (q)\n (fresh (a b c d e)\n (absento `((3 4 ,a) (4 ,b) ((,c)) ,d ,e) q)))\n '(_.0))\n\n(test \"test 50\"\n (run* (q)\n (fresh (a)\n (absento a q)\n (== 5 a)))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 51\"\n (run* (q)\n (fresh (a b c d)\n (== a 5)\n (== a b)\n (== b c)\n (absento d q)\n (== c d)))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 52\"\n (run* (q)\n (fresh (a b c d)\n (== a b)\n (== b c)\n (absento a q)\n (== c d)\n (== d 5)))\n '((_.0 (absento (5 _.0)))))\n\n(test \"test 53\"\n (run* (q)\n (fresh (t1 t2 a)\n (== `(,a . 3) t1)\n (== `(,a . (4 . 3)) t2)\n (== `(,t1 ,t2) q)\n (absento t1 t2)))\n '((((_.0 . 3) (_.0 4 . 3)) (=/= ((_.0 4))))))\n\n(test \"test 54\"\n (run* (q)\n (fresh (a)\n (== `(,a . 3) q)\n (absento q `(,a . (4 . 3)))))\n '(((_.0 . 3) (=/= ((_.0 4))))))\n\n(test \"test 55\"\n (run* (q)\n (fresh (a d c)\n (== '(3 . 4) d)\n (absento `(3 . 4) q)\n (== `(3 . ,d) q)))\n '())\n\n(test \"test 56\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)\n (symbolo a)\n (numbero b)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n\n(test \"test 57\"\n (run* (q)\n (numbero q)\n (absento q 3))\n '((_.0 (=/= ((_.0 3))) (num _.0))))\n\n(test \"test 58\"\n (run* (q)\n (fresh (a)\n (== `(,a . 3) q)\n (absento q `(,a . (4 . (,a . 3))))))\n '())\n\n(test \"test 59\"\n (run* (q) \n (fresh (a) \n (== `(,a . 3) q)\n (absento q `(,a . ((,a . 3) . (,a . 4))))))\n '())\n\n(test \"test 60\"\n (run* (q)\n (fresh (a d c)\n (== `(3 . ,d) q)\n (== '(3 . 4) d)\n (absento `(3 . 4) q)))\n '())\n\n(test \"test 61\"\n (run* (q)\n (fresh (a b c)\n (symbolo b)\n (absento `(,3 . ,a) `(,b . ,c))\n (== `(,a ,b ,c) q)))\n '(((_.0 _.1 _.2) (sym _.1) (absento ((3 . _.0) _.2)))))\n\n(test \"test 62\"\n (run* (q) (fresh (a b c) (absento a b) (absento b c) (absento c q) (symbolo a)))\n '(_.0))\n\n(test \"test 63\"\n (run* (q) (fresh (a b c) (=/= a b) (=/= b c) (=/= c q) (symbolo a)))\n '(_.0))\n\n(test \"test 64\"\n (run* (q) (symbolo q) (== 'tag q))\n '(tag))\n\n(test \"test 65\"\n (run* (q) (fresh (b) (absento '(3 4) `(,q ,b))))\n '((_.0 (absento ((3 4) _.0)))))\n\n(test \"test 66\"\n (run* (q) (absento 6 5))\n '(_.0))\n\n(test \"test 67\"\n (run* (q)\n (fresh (a b)\n (=/= a b)\n (symbolo a)\n (numbero b)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n(test \"test 68\"\n (run* (q)\n (fresh (a b c d)\n (=/= `(,a ,b) `(,c ,d))\n (symbolo a)\n (numbero c)\n (symbolo b)\n (numbero c)\n (== `(,a ,b ,c ,d) q)))\n '(((_.0 _.1 _.2 _.3) (num _.2) (sym _.0 _.1))))\n\n(test \"test 69\"\n (run* (q)\n (fresh (a b)\n (=/= `(,a . 3) `(,b . 3))\n (symbolo a)\n (numbero b)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n(test \"test 70\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)\n (symbolo a)\n (numbero b)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n(test \"test 70b\"\n (run* (q)\n (fresh (a b)\n (symbolo a)\n (numbero b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (num _.1) (sym _.0))))\n\n(test \"test 71\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)\n (symbolo a)\n (symbolo b)))\n '(((_.0 _.1) (=/= ((_.0 _.1))) (sym _.0 _.1))))\n\n(test \"test 72\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (absento b a)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (absento (_.0 _.1) (_.1 _.0)))))\n\n(test \"test 73\"\n (run* (q)\n (fresh (a b)\n (== `(,a ,b) q)\n (absento b a)\n (absento a b)\n (== a '(1 . 2))))\n '((((1 . 2) _.0)\n (=/= ((_.0 1)) ((_.0 2)))\n (absento ((1 . 2) _.0)))))\n\n(test \"test 74\"\n (run* (q)\n (fresh (a b c)\n (absento a q)\n (absento q a)\n (== `(,b . ,c) a)\n (== '(1 . 2) b)\n (== '(3 . 4) c)))\n '((_.0 (=/= ((_.0 1)) ((_.0 2)) ((_.0 3)) ((_.0 4))\n ((_.0 (1 . 2))) ((_.0 (3 . 4))))\n (absento (((1 . 2) 3 . 4) _.0)))))\n\n(test \"test 75\"\n (run* (q)\n (fresh (a b c d e f g)\n (absento a q)\n (absento q a)\n (== `(,b . ,c) a)\n (== `(,d . ,e) b)\n (== `(,f . ,g) c)\n (== '(1 . 2) d)\n (== '(3 . 4) e)\n (== '(5 . 6) f)\n (== '(7 . 8) g)))\n '((_.0 (=/= ((_.0 ((1 . 2) 3 . 4)))\n ((_.0 ((5 . 6) 7 . 8)))\n ((_.0 1))\n ((_.0 2))\n ((_.0 3))\n ((_.0 4))\n ((_.0 5))\n ((_.0 6))\n ((_.0 7))\n ((_.0 8))\n ((_.0 (1 . 2)))\n ((_.0 (3 . 4)))\n ((_.0 (5 . 6)))\n ((_.0 (7 . 8))))\n (absento ((((1 . 2) 3 . 4) (5 . 6) 7 . 8) _.0)))))\n\n(test \"test 76\"\n (run* (q)\n (absento 3 q)\n (absento '(3 4) q))\n '((_.0 (absento (3 _.0)))))\n\n(test \"test 77\"\n (run* (q)\n (fresh (x a b)\n (== x `(,a ,b))\n (absento '(3 4) x)\n (absento 3 a)\n (absento 4 b)\n (== q `(,a 2))))\n '(((_.0 2) (absento (3 _.0)))))\n\n(test \"test 78\"\n (run* (q)\n (fresh (d)\n (== `(3 . ,d) q)\n (absento `(3 . 4) q)\n (== '(3 . 4) d)))\n '())\n\n(test \"test 79\"\n (run* (q)\n (fresh (d)\n (absento `(3 . 4) q)\n (== `(3 . ,d) q)\n (== '(3 . 4) d)))\n '())\n\n(test \"test 80\"\n (run* (q)\n (fresh (d a c)\n (== `(3 . ,d) q)\n (absento `(3 . ,a) q)\n (== c d)\n (== `(3 . ,a) c)))\n '())\n\n(test \"test 81\"\n (run* (q)\n (fresh (a b)\n (absento `(3 . ,a) `(,b . 4))\n (== `(,a . ,b) q)))\n '(((_.0 . _.1) (=/= ((_.0 4) (_.1 3))) (absento ((3 . _.0) _.1)))))\n\n(test \"test 82\"\n (run* (q)\n (fresh (d)\n (== `(3 . ,d) q)\n (absento `(3 . 4) q)))\n '(((3 . _.0) (=/= ((_.0 4))) (absento ((3 . 4) _.0)))))\n\n(test \"test 83\"\n (run* (q)\n (fresh (d)\n (== `(3 . ,d) q)\n (== '(3 . 4) d))\n (absento `(3 . 4) q))\n '())\n\n(test \"test 84\"\n (run* (q) \n (fresh (a b c d) \n (=/= `(,a . ,b) `(,c . ,d))\n (absento a c)\n (== `(,a ,b ,c ,d) q)))\n '(((_.0 _.1 _.2 _.3) (absento (_.0 _.2)))))\n\n(test \"test 84 b\"\n (run* (q)\n (fresh (a b c d) \n (=/= `(,a . ,b) `(,c . ,d)) \n (absento c a) \n (== `(,a ,b ,c ,d) q)))\n '(((_.0 _.1 _.2 _.3) (absento (_.2 _.0)))))\n\n(test \"test 85 a\"\n (run* (q)\n (fresh (a b)\n (=/= a b)\n (absento a b)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (absento (_.0 _.1)))))\n\n(test \"test 85 b\"\n (run* (q)\n (fresh (a b)\n (absento a b)\n (=/= a b)\n (== `(,a ,b) q)))\n '(((_.0 _.1) (absento (_.0 _.1)))))\n" }, { "path": "disequality-tests.scm", "content": "(test \"=/=-0\"\n (run* (q) (=/= 5 q))\n '((_.0 (=/= ((_.0 5))))))\n\n(test \"=/=-1\"\n (run* (q)\n (=/= 3 q)\n (== q 3))\n '())\n\n(test \"=/=-2\"\n (run* (q)\n (== q 3)\n (=/= 3 q))\n '())\n\n(test \"=/=-3\"\n (run* (q)\n (fresh (x y)\n (=/= x y)\n (== x y)))\n '())\n\n(test \"=/=-4\"\n (run* (q)\n (fresh (x y)\n (== x y)\n (=/= x y)))\n '())\n\n(test \"=/=-5\"\n (run* (q)\n (fresh (x y)\n (=/= x y)\n (== 3 x)\n (== 3 y)))\n '())\n\n(test \"=/=-6\"\n (run* (q)\n (fresh (x y)\n (== 3 x)\n (=/= x y)\n (== 3 y)))\n '())\n\n(test \"=/=-7\"\n (run* (q)\n (fresh (x y)\n (== 3 x)\n (== 3 y)\n (=/= x y)))\n '())\n\n(test \"=/=-8\"\n (run* (q)\n (fresh (x y)\n (== 3 x)\n (== 3 y)\n (=/= y x)))\n '())\n\n(test \"=/=-9\"\n (run* (q)\n (fresh (x y z)\n (== x y)\n (== y z)\n (=/= x 4)\n (== z (+ 2 2))))\n '())\n\n(test \"=/=-10\"\n (run* (q)\n (fresh (x y z)\n (== x y)\n (== y z)\n (== z (+ 2 2))\n (=/= x 4)))\n '())\n\n(test \"=/=-11\"\n (run* (q)\n (fresh (x y z)\n (=/= x 4)\n (== y z)\n (== x y)\n (== z (+ 2 2))))\n '())\n\n(test \"=/=-12\"\n (run* (q)\n (fresh (x y z)\n (=/= x y)\n (== x `(0 ,z 1))\n (== y `(0 1 1))))\n '(_.0))\n\n(test \"=/=-13\"\n (run* (q)\n (fresh (x y z)\n (=/= x y)\n (== x `(0 ,z 1))\n (== y `(0 1 1))\n (== z 1)\n (== `(,x ,y) q)))\n '())\n\n(test \"=/=-14\"\n (run* (q)\n (fresh (x y z)\n (=/= x y)\n (== x `(0 ,z 1))\n (== y `(0 1 1))\n (== z 0)))\n '(_.0))\n\n(test \"=/=-15\"\n (run* (q)\n (fresh (x y z)\n (== z 0)\n (=/= x y)\n (== x `(0 ,z 1))\n (== y `(0 1 1))))\n '(_.0))\n\n(test \"=/=-16\"\n (run* (q)\n (fresh (x y z)\n (== x `(0 ,z 1))\n (== y `(0 1 1))\n (=/= x y)))\n '(_.0))\n\n(test \"=/=-17\"\n (run* (q)\n (fresh (x y z)\n (== z 1)\n (=/= x y)\n (== x `(0 ,z 1))\n (== y `(0 1 1))))\n '())\n\n(test \"=/=-18\"\n (run* (q)\n (fresh (x y z)\n (== z 1)\n (== x `(0 ,z 1))\n (== y `(0 1 1))\n (=/= x y)))\n '())\n\n(test \"=/=-19\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== x 2)))\n '(_.0))\n\n(test \"=/=-20\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== y 1)))\n '(_.0))\n\n(test \"=/=-21\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== x 2)\n (== y 1)))\n '())\n\n(test \"=/=-22\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== `(,x ,y) q)))\n '(((_.0 _.1) (=/= ((_.0 2) (_.1 1))))))\n\n(test \"=/=-23\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== x 2)\n (== `(,x ,y) q)))\n '(((2 _.0) (=/= ((_.0 1))))))\n\n(test \"=/=-24\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== x 2)\n (== y 9)\n (== `(,x ,y) q)))\n '((2 9)))\n\n(test \"=/=-24b\"\n (run* (q)\n (fresh (a d)\n (== `(,a . ,d) q)\n (=/= q `(5 . 6))\n (== a 5)\n (== d 6)))\n '())\n\n(test \"=/=-25\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x 1) `(2 ,y))\n (== x 2)\n (== y 1)\n (== `(,x ,y) q)))\n '())\n\n(test \"=/=-26\"\n (run* (q)\n (fresh (a x z)\n (=/= a `(,x 1))\n (== a `(,z 1))\n (== x z)))\n '())\n\n(test \"=/=-27\"\n (run* (q)\n (fresh (a x z)\n (=/= a `(,x 1))\n (== a `(,z 1))\n (== x 5)\n (== `(,x ,z) q)))\n '(((5 _.0) (=/= ((_.0 5))))))\n\n(test \"=/=-28\"\n (run* (q)\n (=/= 3 4))\n '(_.0))\n\n(test \"=/=-29\"\n (run* (q)\n (=/= 3 3))\n '())\n\n(test \"=/=-30\"\n (run* (q) (=/= 5 q)\n\t (=/= 6 q)\n\t (== q 5))\n '())\n\n(test \"=/=-31\"\n (run* (q)\n (fresh (a d)\n (== `(,a . ,d) q)\n (=/= q `(5 . 6))\n (== a 5)))\n '(((5 . _.0) (=/= ((_.0 6))))))\n\n(test \"=/=-32\"\n (run* (q)\n (fresh (a)\n (== 3 a)\n (=/= a 4)))\n '(_.0))\n\n(test \"=/=-33\"\n (run* (q)\n (=/= 4 q)\n (=/= 3 q))\n '((_.0 (=/= ((_.0 3)) ((_.0 4))))))\n\n(test \"=/=-34\"\n (run* (q) (=/= q 5) (=/= q 5))\n '((_.0 (=/= ((_.0 5))))))\n\n(test \"=/=-35\"\n (let ((foo (lambda (x)\n (fresh (a)\n (=/= x a)))))\n (run* (q) (fresh (a) (foo a))))\n '(_.0))\n\n(test \"=/=-36\"\n (let ((foo (lambda (x)\n (fresh (a)\n (=/= x a)))))\n (run* (q) (fresh (b) (foo b))))\n '(_.0))\n\n(test \"=/=-37\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= x y)))\n '(((_.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"=/=-37b\"\n (run* (q)\n (fresh (a d)\n (== `(,a . ,d) q)\n (=/= q `(5 . 6))))\n '(((_.0 . _.1) (=/= ((_.0 5) (_.1 6))))))\n\n(test \"=/=-37c\"\n (run* (q)\n (fresh (a d)\n (== `(,a . ,d) q)\n (=/= q `(5 . 6))\n (== a 3)))\n '((3 . _.0)))\n\n(test \"=/=-38\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= y x)))\n '(((_.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"=/=-39\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= x y)\n (=/= y x)))\n '(((_.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"=/=-40\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= x y)\n (=/= x y)))\n '(((_.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"=/=-41\"\n (run* (q) (=/= q 5) (=/= 5 q))\n '((_.0 (=/= ((_.0 5))))))\n\n(test \"=/=-42\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= `(,x ,y) `(5 6))\n (=/= x 5)))\n '(((_.0 _.1) (=/= ((_.0 5))))))\n\n(test \"=/=-43\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= x 5)\n (=/= `(,x ,y) `(5 6))))\n '(((_.0 _.1) (=/= ((_.0 5))))))\n\n(test \"=/=-44\"\n (run* (q)\n (fresh (x y)\n (=/= x 5)\n (=/= `(,x ,y) `(5 6))\n (== `(,x ,y) q)))\n '(((_.0 _.1) (=/= ((_.0 5))))))\n\n(test \"=/=-45\"\n (run* (q)\n (fresh (x y)\n (=/= 5 x)\n (=/= `(,x ,y) `(5 6))\n (== `(,x ,y) q)))\n '(((_.0 _.1) (=/= ((_.0 5))))))\n\n(test \"=/=-46\"\n (run* (q)\n (fresh (x y)\n (=/= 5 x)\n (=/= `( ,y ,x) `(6 5))\n (== `(,x ,y) q)))\n '(((_.0 _.1) (=/= ((_.0 5))))))\n\n(test \"=/=-47\"\n (run* (x)\n (fresh (y z)\n (=/= x `(,y 2))\n (== x `(,z 2))))\n '((_.0 2)))\n\n(test \"=/=-48\"\n (run* (x)\n (fresh (y z)\n (=/= x `(,y 2))\n (== x `((,z) 2))))\n '(((_.0) 2)))\n\n(test \"=/=-49\"\n (run* (x)\n (fresh (y z)\n (=/= x `((,y) 2))\n (== x `(,z 2))))\n '((_.0 2)))\n\n(define distincto\n (lambda (l)\n (conde\n ((== l '()))\n ((fresh (a) (== l `(,a))))\n ((fresh (a ad dd)\n (== l `(,a ,ad . ,dd))\n (=/= a ad)\n (distincto `(,a . ,dd))\n (distincto `(,ad . ,dd)))))))\n\n(test \"=/=-50\"\n (run* (q)\n (distincto `(2 3 ,q)))\n '((_.0 (=/= ((_.0 2)) ((_.0 3))))))\n\n(define rembero\n (lambda (x ls out)\n (conde\n ((== '() ls) (== '() out))\n ((fresh (a d res)\n (== `(,a . ,d) ls)\n (rembero x d res)\n (conde\n ((== a x) (== out res))\n ((== `(,a . ,res) out))))))))\n\n(test \"=/=-51\"\n (run* (q) (rembero 'a '(a b a c) q))\n '((b c) (b a c) (a b c) (a b a c)))\n\n(test \"=/=-52\"\n (run* (q) (rembero 'a '(a b c) '(a b c)))\n '(_.0))\n\n(define rembero\n (lambda (x ls out)\n (conde\n ((== '() ls) (== '() out))\n ((fresh (a d res)\n (== `(,a . ,d) ls)\n (rembero x d res)\n (conde\n ((== a x) (== out res))\n ((=/= a x) (== `(,a . ,res) out))))))))\n\n(test \"=/=-53\"\n (run* (q) (rembero 'a '(a b a c) q))\n '((b c)))\n\n(test \"=/=-54\"\n (run* (q) (rembero 'a '(a b c) '(a b c)))\n '())\n\n(test \"=/=-55\"\n (run 1 (q) (=/= q #f))\n '((_.0 (=/= ((_.0 #f))))))\n" }, { "path": "matche.rkt", "content": "#lang racket\r\n(require \"mk.rkt\")\r\n(require (for-syntax racket/syntax))\r\n\r\n(provide matche lambdae defmatche)\r\n\r\n(define-for-syntax memp memf)\r\n\r\n(include \"matche.scm\")\r\n" }, { "path": "matche.scm", "content": "; new version of matche\n; fixes depth related issues, and works with dots\n;\n; https://github.com/calvis/cKanren/blob/dev/cKanren/matche.rkt#L54\n\n; Note that this definition is available at syntax phase in chez and vicare due to implicit\n; phasing, but not in Racket (which uses explicit phasing). Racket already has a version available\n; by default though, so that's fine. This definition isn't just isn't used in Racket.\n(define syntax->list\n (lambda (e)\n (syntax-case e ()\n [() '()]\n [(x . r) (cons #'x (syntax->list #'r))])))\n\n(define-syntax defmatche\n (lambda (stx)\n (syntax-case stx ()\n [(defmatche (name args ...) clause ...)\n #'(define (name args ...)\n (matche (args ...) clause ...))])))\n\n(define-syntax lambdae\n (syntax-rules ()\n ((_ (x ...) c c* ...)\n (lambda (x ...) (matche (x ...) c c* ...)))))\n\n(define-syntax matche\n (lambda (stx) \n (syntax-case stx ()\n [(matche (v ...) ([pat ...] g ...) ...)\n (let ()\n (define remove-duplicates\n (lambda (ls eq-pred)\n (cond\n [(null? ls) '()]\n [(memp (lambda (x) (eq-pred (car ls) x)) (cdr ls))\n (remove-duplicates (cdr ls) eq-pred)]\n [else (cons (car ls) (remove-duplicates (cdr ls) eq-pred))])))\n (define parse-pattern\n (lambda (args pat)\n (syntax-case #`(#,args #,pat) ()\n [(() ()) #'(() () ())]\n [((a args ...) [p pat ...])\n (with-syntax ([(p^ (c ...) (x ...))\n (parse-patterns-for-arg #'a #'p)])\n (with-syntax ([([pat^ ...] (c^ ...) (x^ ...))\n (parse-pattern #'(args ...) #'[pat ...])])\n #'([p^ pat^ ...] (c ... c^ ...) (x ... x^ ...))))]\n [x (error 'parse-pattern \"bad syntax ~s ~s\" args pat)])))\n (define parse-patterns-for-arg\n (lambda (v pat)\n (define loop\n (lambda (pat)\n (syntax-case pat (unquote ?? ?) ; ?? is the new _, since _ isn't legal in R6\n [(unquote ??)\n (with-syntax ([_new (generate-temporary #'?_)])\n #'((unquote _new) () (_new)))]\n [(unquote x)\n (when (free-identifier=? #'x v)\n (error 'matche \"argument ~s appears in pattern at an invalid depth\"\n (syntax->datum #'x)))\n #'((unquote x) () (x))]\n [(unquote (? c x))\n (when (free-identifier=? #'x v)\n (error 'matche \"argument ~s appears in pattern at an invalid depth\"\n (syntax->datum #'x)))\n #'((unquote x) ((c x)) (x))]\n [(a . d)\n (with-syntax ([((pat1 (c1 ...) (x1 ...))\n (pat2 (c2 ...) (x2 ...)))\n (map loop (syntax->list #'(a d)))])\n #'((pat1 . pat2) (c1 ... c2 ...) (x1 ... x2 ...)))]\n [x #'(x () ())])))\n (syntax-case pat (unquote ?)\n [(unquote u)\n (cond\n [(and (identifier? #'u)\n (free-identifier=? v #'u))\n #'((unquote u) () ())]\n [else (loop pat)])]\n [(unquote (? c u))\n (cond\n [(and (identifier? #'u)\n (free-identifier=? v #'u))\n #'((unquote u) ((c x)) ())]\n [else (loop pat)])]\n [else (loop pat)])))\n (unless\n (andmap (lambda (y) (= (length (syntax->datum #'(v ...))) (length y)))\n (syntax->datum #'([pat ...] ...)))\n (error 'matche \"pattern wrong length blah\"))\n (with-syntax ([(([pat^ ...] (c ...) (x ...)) ...)\n (map (lambda (y) (parse-pattern #'(v ...) y))\n (syntax->list #'([pat ...] ...)))])\n (with-syntax ([((x^ ...) ...)\n (map (lambda (ls)\n (remove-duplicates (syntax->list ls) free-identifier=?))\n (syntax->list #'((x ...) ...)))])\n (with-syntax ([body\n #'(conde\n [(fresh (x^ ...) c ... (== `[pat^ ...] ls) g ...)]\n ...)])\n #'(let ([ls (list v ...)]) body)))))]\n [(matche v (pat g ...) ...)\n #'(matche (v) ([pat] g ...) ...)])))\n" }, { "path": "mk-chicken.scm", "content": "(define (list-sort x y) (sort y x))\n\n(define (exists p l)\n (if (null? l)\n #f\n (let ((res (p (car l))))\n (if (null? (cdr l))\n res\n (if res\n res\n (exists p (cdr l)))))))\n\n(define (find p l)\n (if (null? l)\n #f\n (if (p (car l))\n (car l)\n (find p (cdr l)))))\n\n(define (remp p l)\n (if (null? l)\n '()\n (if (p (car l))\n (remp p (cdr l))\n (cons (car l) (remp p (cdr l))))))\n\n(define (for-all p l)\n (if (null? l)\n #t\n (let ((res (p (car l))))\n (if (null? (cdr l))\n res\n (if res\n (for-all p (cdr l))\n #f)))))\n\n(define call-with-string-output-port call-with-output-string)\n\n(load \"mk.scm\")\n" }, { "path": "mk-guile.scm", "content": "(import (rnrs sorting (6))\n (rnrs lists (6)))\n\n(define (sub1 n)\n (- n 1))\n\n(define call-with-string-output-port call-with-output-string)\n\n(define (printf format-string . args)\n (display (apply format #f format-string args)))\n\n(load \"mk.scm\")\n" }, { "path": "mk.rkt", "content": "#lang racket\r\n\r\n(require racket/trace)\r\n\r\n\r\n(provide run run*\r\n == =/=\r\n fresh eigen\r\n conde conda condu\r\n symbolo numbero ;; not-pairo\r\n absento\r\n project)\r\n\r\n;; extra stuff for racket\r\n;; due mostly to samth\r\n(define (list-sort f l) (sort l f))\r\n(define (remp f l) (filter-not f l))\r\n(define (call-with-string-output-port f)\r\n (define p (open-output-string))\r\n (f p)\r\n (get-output-string p))\r\n(define (exists f l) (ormap f l))\r\n(define for-all andmap)\r\n(define (find f l)\r\n (cond [(memf f l) => car] [else #f]))\r\n(define memp memf)\r\n(define (var*? v) (var? (car v)))\r\n\r\n;; actual code\r\n\r\n(include \"mk.scm\")\r\n" }, { "path": "mk.scm", "content": ";;; 28 November 02014 WEB\n;;;\n;;; * Fixed missing unquote before E in 'drop-Y-b/c-dup-var'\n;;;\n;;; * Updated 'rem-xx-from-d' to check against other constraints after\n;;; unification, in order to remove redundant disequality constraints\n;;; subsumed by absento constraints.\n\n;;; newer version: Sept. 18 2013 (with eigens)\n;;; Jason Hemann, Will Byrd, and Dan Friedman\n;;; E = (e* . x*)*, where e* is a list of eigens and x* is a list of variables.\n;;; Each e in e* is checked for any of its eigens be in any of its x*. Then it fails.\n;;; Since eigen-occurs-check is chasing variables, we might as will do a memq instead\n;;; of an eq? when an eigen is found through a chain of walks. See eigen-occurs-check.\n;;; All the e* must be the eigens created as part of a single eigen. The reifier just\n;;; abandons E, if it succeeds. If there is no failure by then, there were no eigen\n;;; violations.\n\n(define empty-c '(() () () () () () ()))\n\n(define eigen-tag (vector 'eigen-tag))\n\n(define-syntax inc\n (syntax-rules ()\n ((_ e) (lambdaf@ () e))))\n\n(define-syntax lambdaf@\n (syntax-rules ()\n ((_ () e) (lambda () e))))\n\n(define-syntax lambdag@\n (syntax-rules (:)\n ((_ (c) e) (lambda (c) e))\n ((_ (c : B E S) e)\n (lambda (c)\n (let ((B (c->B c)) (E (c->E c)) (S (c->S c)))\n e)))\n ((_ (c : B E S D Y N T) e)\n (lambda (c)\n (let ((B (c->B c)) (E (c->E c)) (S (c->S c)) (D (c->D c))\n\t (Y (c->Y c)) (N (c->N c)) (T (c->T c)))\n e)))))\n\n(define rhs\n (lambda (pr)\n (cdr pr)))\n\n(define lhs\n (lambda (pr)\n (car pr)))\n\n(define eigen-var\n (lambda ()\n (vector eigen-tag)))\n\n(define eigen?\n (lambda (x)\n (and (vector? x) (eq? (vector-ref x 0) eigen-tag))))\n\n(define var\n (lambda (dummy)\n (vector dummy)))\n\n(define var?\n (lambda (x)\n (and (vector? x) (not (eq? (vector-ref x 0) eigen-tag)))))\n\n(define walk\n (lambda (u S)\n (cond\n ((and (var? u) (assq u S)) =>\n (lambda (pr) (walk (rhs pr) S)))\n (else u))))\n\n(define prefix-S\n (lambda (S+ S)\n (cond\n ((eq? S+ S) '())\n (else (cons (car S+)\n (prefix-S (cdr S+) S))))))\n\n(define unify\n (lambda (u v s)\n (let ((u (walk u s))\n (v (walk v s)))\n (cond\n ((eq? u v) s)\n ((var? u) (ext-s-check u v s))\n ((var? v) (ext-s-check v u s))\n ((and (pair? u) (pair? v))\n (let ((s (unify (car u) (car v) s)))\n (and s (unify (cdr u) (cdr v) s))))\n ((or (eigen? u) (eigen? v)) #f)\n ((equal? u v) s)\n (else #f)))))\n\n(define occurs-check\n (lambda (x v s)\n (let ((v (walk v s)))\n (cond\n ((var? v) (eq? v x))\n ((pair? v)\n (or\n (occurs-check x (car v) s)\n (occurs-check x (cdr v) s)))\n (else #f)))))\n\n(define eigen-occurs-check\n (lambda (e* x s)\n (let ((x (walk x s)))\n (cond\n ((var? x) #f)\n ((eigen? x) (memq x e*))\n ((pair? x)\n (or\n (eigen-occurs-check e* (car x) s)\n (eigen-occurs-check e* (cdr x) s)))\n (else #f)))))\n\n(define empty-f (lambdaf@ () (mzero)))\n\n(define ext-s-check\n (lambda (x v s)\n (cond\n ((occurs-check x v s) #f)\n (else (cons `(,x . ,v) s)))))\n\n(define unify*\n (lambda (S+ S)\n (unify (map lhs S+) (map rhs S+) S)))\n\n(define-syntax case-inf\n (syntax-rules ()\n ((_ e (() e0) ((f^) e1) ((c^) e2) ((c f) e3))\n (let ((c-inf e))\n (cond\n ((not c-inf) e0)\n ((procedure? c-inf) (let ((f^ c-inf)) e1))\n ((not (and (pair? c-inf)\n (procedure? (cdr c-inf))))\n (let ((c^ c-inf)) e2))\n (else (let ((c (car c-inf)) (f (cdr c-inf)))\n e3)))))))\n\n(define-syntax fresh\n (syntax-rules ()\n ((_ (x ...) g0 g ...)\n (lambdag@ (c : B E S D Y N T)\n (inc\n (let ((x (var 'x)) ...)\n (let ((B (append `(,x ...) B)))\n (bind* (g0 `(,B ,E ,S ,D ,Y ,N ,T)) g ...))))))))\n\n(define-syntax eigen\n (syntax-rules ()\n ((_ (x ...) g0 g ...)\n (lambdag@ (c : B E S)\n (let ((x (eigen-var)) ...)\n ((fresh () (eigen-absento `(,x ...) B) g0 g ...) c))))))\n\n(define-syntax bind*\n (syntax-rules ()\n ((_ e) e)\n ((_ e g0 g ...) (bind* (bind e g0) g ...))))\n\n(define bind\n (lambda (c-inf g)\n (case-inf c-inf\n (() (mzero))\n ((f) (inc (bind (f) g)))\n ((c) (g c))\n ((c f) (mplus (g c) (lambdaf@ () (bind (f) g)))))))\n\n(define-syntax run\n (syntax-rules ()\n ((_ n (q) g0 g ...)\n (take n\n (lambdaf@ ()\n ((fresh (q) g0 g ...\n (lambdag@ (final-c)\n (let ((z ((reify q) final-c)))\n (choice z empty-f))))\n empty-c))))\n ((_ n (q0 q1 q ...) g0 g ...)\n (run n (x) (fresh (q0 q1 q ...) g0 g ... (== `(,q0 ,q1 ,q ...) x))))))\n\n(define-syntax run*\n (syntax-rules ()\n ((_ (q0 q ...) g0 g ...) (run #f (q0 q ...) g0 g ...))))\n\n(define take\n (lambda (n f)\n (cond\n ((and n (zero? n)) '())\n (else\n (case-inf (f)\n (() '())\n ((f) (take n f))\n ((c) (cons c '()))\n ((c f) (cons c\n (take (and n (- n 1)) f))))))))\n\n(define-syntax conde\n (syntax-rules ()\n ((_ (g0 g ...) (g1 g^ ...) ...)\n (lambdag@ (c)\n (inc\n (mplus*\n (bind* (g0 c) g ...)\n (bind* (g1 c) g^ ...) ...))))))\n\n(define-syntax mplus*\n (syntax-rules ()\n ((_ e) e)\n ((_ e0 e ...) (mplus e0\n (lambdaf@ () (mplus* e ...))))))\n\n(define mplus\n (lambda (c-inf f)\n (case-inf c-inf\n (() (f))\n ((f^) (inc (mplus (f) f^)))\n ((c) (choice c f))\n ((c f^) (choice c (lambdaf@ () (mplus (f) f^)))))))\n\n\n(define c->B (lambda (c) (car c)))\n(define c->E (lambda (c) (cadr c)))\n(define c->S (lambda (c) (caddr c)))\n(define c->D (lambda (c) (cadddr c)))\n(define c->Y (lambda (c) (cadddr (cdr c))))\n(define c->N (lambda (c) (cadddr (cddr c))))\n(define c->T (lambda (c) (cadddr (cdddr c))))\n\n(define-syntax conda\n (syntax-rules ()\n ((_ (g0 g ...) (g1 g^ ...) ...)\n (lambdag@ (c)\n (inc\n (ifa ((g0 c) g ...)\n ((g1 c) g^ ...) ...))))))\n\n(define-syntax ifa\n (syntax-rules ()\n ((_) (mzero))\n ((_ (e g ...) b ...)\n (let loop ((c-inf e))\n (case-inf c-inf\n (() (ifa b ...))\n ((f) (inc (loop (f))))\n ((a) (bind* c-inf g ...))\n ((a f) (bind* c-inf g ...)))))))\n\n(define-syntax condu\n (syntax-rules ()\n ((_ (g0 g ...) (g1 g^ ...) ...)\n (lambdag@ (c)\n (inc\n (ifu ((g0 c) g ...)\n ((g1 c) g^ ...) ...))))))\n\n(define-syntax ifu\n (syntax-rules ()\n ((_) (mzero))\n ((_ (e g ...) b ...)\n (let loop ((c-inf e))\n (case-inf c-inf\n (() (ifu b ...))\n ((f) (inc (loop (f))))\n ((c) (bind* c-inf g ...))\n ((c f) (bind* (unit c) g ...)))))))\n\n(define mzero (lambda () #f))\n\n(define unit (lambda (c) c))\n\n(define choice (lambda (c f) (cons c f)))\n\n(define tagged?\n (lambda (S Y y^)\n (exists (lambda (y) (eqv? (walk y S) y^)) Y)))\n\n(define untyped-var?\n (lambda (S Y N t^)\n (let ((in-type? (lambda (y) (eq? (walk y S) t^))))\n (and (var? t^)\n (not (exists in-type? Y))\n (not (exists in-type? N))))))\n\n(define-syntax project\n (syntax-rules ()\n ((_ (x ...) g g* ...)\n (lambdag@ (c : B E S)\n (let ((x (walk* x S)) ...)\n ((fresh () g g* ...) c))))))\n\n(define walk*\n (lambda (v S)\n (let ((v (walk v S)))\n (cond\n ((var? v) v)\n ((pair? v)\n (cons (walk* (car v) S) (walk* (cdr v) S)))\n (else v)))))\n\n(define reify-S\n (lambda (v S)\n (let ((v (walk v S)))\n (cond\n ((var? v)\n (let ((n (length S)))\n (let ((name (reify-name n)))\n (cons `(,v . ,name) S))))\n ((pair? v)\n (let ((S (reify-S (car v) S)))\n (reify-S (cdr v) S)))\n (else S)))))\n\n(define reify-name\n (lambda (n)\n (string->symbol\n (string-append \"_\" \".\" (number->string n)))))\n\n(define drop-dot\n (lambda (X)\n (map (lambda (t)\n (let ((a (lhs t))\n (d (rhs t)))\n `(,a ,d)))\n X)))\n\n(define sorter\n (lambda (ls)\n (list-sort lex<=? ls)))\n\n(define lex<=?\n (lambda (x y)\n (string<=? (datum->string x) (datum->string y))))\n\n(define datum->string\n (lambda (x)\n (call-with-string-output-port\n (lambda (p) (display x p)))))\n\n(define anyvar?\n (lambda (u r)\n (cond\n ((pair? u)\n (or (anyvar? (car u) r)\n (anyvar? (cdr u) r)))\n (else (var? (walk u r))))))\n\n(define anyeigen?\n (lambda (u r)\n (cond\n ((pair? u)\n (or (anyeigen? (car u) r)\n (anyeigen? (cdr u) r)))\n (else (eigen? (walk u r))))))\n\n(define member*\n (lambda (u v)\n (cond\n ((equal? u v) #t)\n ((pair? v)\n (or (member* u (car v)) (member* u (cdr v))))\n (else #f))))\n\n;;;\n\n(define drop-N-b/c-const\n (lambdag@ (c : B E S D Y N T)\n (let ((const? (lambda (n)\n (not (var? (walk n S))))))\n (cond\n ((find const? N) =>\n (lambda (n) `(,B ,E ,S ,D ,Y ,(remq1 n N) ,T)))\n (else c)))))\n\n(define drop-Y-b/c-const\n (lambdag@ (c : B E S D Y N T)\n (let ((const? (lambda (y)\n (not (var? (walk y S))))))\n (cond\n\t((find const? Y) =>\n (lambda (y) `(,B ,E ,S ,D ,(remq1 y Y) ,N ,T)))\n (else c)))))\n\n(define remq1\n (lambda (elem ls)\n (cond\n ((null? ls) '())\n ((eq? (car ls) elem) (cdr ls))\n (else (cons (car ls) (remq1 elem (cdr ls)))))))\n\n(define same-var?\n (lambda (v)\n (lambda (v^)\n (and (var? v) (var? v^) (eq? v v^)))))\n\n(define find-dup\n (lambda (f S)\n (lambda (set)\n (let loop ((set^ set))\n (cond\n ((null? set^) #f)\n (else\n (let ((elem (car set^)))\n (let ((elem^ (walk elem S)))\n (cond\n ((find (lambda (elem^^)\n ((f elem^) (walk elem^^ S)))\n (cdr set^))\n elem)\n (else (loop (cdr set^))))))))))))\n\n(define drop-N-b/c-dup-var\n (lambdag@ (c : B E S D Y N T)\n (cond\n (((find-dup same-var? S) N) =>\n (lambda (n) `(,B ,E ,S ,D ,Y ,(remq1 n N) ,T)))\n (else c))))\n\n(define drop-Y-b/c-dup-var\n (lambdag@ (c : B E S D Y N T)\n (cond\n (((find-dup same-var? S) Y) =>\n (lambda (y)\n `(,B ,E ,S ,D ,(remq1 y Y) ,N ,T)))\n (else c))))\n\n(define var-type-mismatch?\n (lambda (S Y N t1^ t2^)\n (cond\n ((num? S N t1^) (not (num? S N t2^)))\n ((sym? S Y t1^) (not (sym? S Y t2^)))\n (else #f))))\n\n(define term-ununifiable?\n (lambda (S Y N t1 t2)\n (let ((t1^ (walk t1 S))\n (t2^ (walk t2 S)))\n (cond\n ((or (untyped-var? S Y N t1^) (untyped-var? S Y N t2^)) #f)\n ((var? t1^) (var-type-mismatch? S Y N t1^ t2^))\n ((var? t2^) (var-type-mismatch? S Y N t2^ t1^))\n ((and (pair? t1^) (pair? t2^))\n (or (term-ununifiable? S Y N (car t1^) (car t2^))\n (term-ununifiable? S Y N (cdr t1^) (cdr t2^))))\n (else (not (eqv? t1^ t2^)))))))\n\n(define T-term-ununifiable?\n (lambda (S Y N)\n (lambda (t1)\n (let ((t1^ (walk t1 S)))\n (letrec\n ((t2-check\n (lambda (t2)\n (let ((t2^ (walk t2 S)))\n (cond\n ((pair? t2^) (and\n (term-ununifiable? S Y N t1^ t2^)\n (t2-check (car t2^))\n (t2-check (cdr t2^))))\n (else (term-ununifiable? S Y N t1^ t2^)))))))\n t2-check)))))\n\n(define num?\n (lambda (S N n)\n (let ((n (walk n S)))\n (cond\n ((var? n) (tagged? S N n))\n (else (number? n))))))\n\n(define sym?\n (lambda (S Y y)\n (let ((y (walk y S)))\n (cond\n ((var? y) (tagged? S Y y))\n (else (symbol? y))))))\n\n(define drop-T-b/c-Y-and-N\n (lambdag@ (c : B E S D Y N T)\n (let ((drop-t? (T-term-ununifiable? S Y N)))\n (cond\n ((find (lambda (t) ((drop-t? (lhs t)) (rhs t))) T) =>\n (lambda (t) `(,B ,E ,S ,D ,Y ,N ,(remq1 t T))))\n (else c)))))\n\n(define move-T-to-D-b/c-t2-atom\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((exists (lambda (t)\n (let ((t2^ (walk (rhs t) S)))\n (cond\n ((and (not (untyped-var? S Y N t2^))\n (not (pair? t2^)))\n (let ((T (remq1 t T)))\n `(,B ,E ,S ((,t) . ,D) ,Y ,N ,T)))\n (else #f))))\n T))\n (else c))))\n\n(define terms-pairwise=?\n (lambda (pr-a^ pr-d^ t-a^ t-d^ S)\n (or\n (and (term=? pr-a^ t-a^ S)\n (term=? pr-d^ t-a^ S))\n (and (term=? pr-a^ t-d^ S)\n (term=? pr-d^ t-a^ S)))))\n\n(define T-superfluous-pr?\n (lambda (S Y N T)\n (lambda (pr)\n (let ((pr-a^ (walk (lhs pr) S))\n (pr-d^ (walk (rhs pr) S)))\n (cond\n ((exists\n (lambda (t)\n (let ((t-a^ (walk (lhs t) S))\n (t-d^ (walk (rhs t) S)))\n (terms-pairwise=? pr-a^ pr-d^ t-a^ t-d^ S)))\n T)\n (for-all\n (lambda (t)\n (let ((t-a^ (walk (lhs t) S))\n (t-d^ (walk (rhs t) S)))\n (or\n (not (terms-pairwise=? pr-a^ pr-d^ t-a^ t-d^ S))\n (untyped-var? S Y N t-d^)\n (pair? t-d^))))\n T))\n (else #f))))))\n\n(define drop-from-D-b/c-T\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((find\n (lambda (d)\n (exists\n (T-superfluous-pr? S Y N T)\n d))\n D) =>\n (lambda (d) `(,B ,E ,S ,(remq1 d D) ,Y ,N ,T)))\n (else c))))\n\n(define drop-t-b/c-t2-occurs-t1\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((find (lambda (t)\n (let ((t-a^ (walk (lhs t) S))\n (t-d^ (walk (rhs t) S)))\n (mem-check t-d^ t-a^ S)))\n T) =>\n (lambda (t)\n `(,B ,E ,S ,D ,Y ,N ,(remq1 t T))))\n (else c))))\n\n(define split-t-move-to-d-b/c-pair\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((exists\n (lambda (t)\n (let ((t2^ (walk (rhs t) S)))\n (cond\n ((pair? t2^) (let ((ta `(,(lhs t) . ,(car t2^)))\n (td `(,(lhs t) . ,(cdr t2^))))\n (let ((T `(,ta ,td . ,(remq1 t T))))\n `(,B ,E ,S ((,t) . ,D) ,Y ,N ,T))))\n (else #f))))\n T))\n (else c))))\n\n(define find-d-conflict\n (lambda (S Y N)\n (lambda (D)\n (find\n (lambda (d)\n\t (exists (lambda (pr)\n\t\t (term-ununifiable? S Y N (lhs pr) (rhs pr)))\n\t\t d))\n D))))\n\n(define drop-D-b/c-Y-or-N\n (lambdag@ (c : B E S D Y N T)\n (cond\n (((find-d-conflict S Y N) D) =>\n (lambda (d) `(,B ,E ,S ,(remq1 d D) ,Y ,N ,T)))\n (else c))))\n\n(define cycle\n (lambdag@ (c)\n (let loop ((c^ c)\n (fns^ (LOF))\n (n (length (LOF))))\n (cond\n ((zero? n) c^)\n ((null? fns^) (loop c^ (LOF) n))\n (else\n (let ((c^^ ((car fns^) c^)))\n (cond\n ((not (eq? c^^ c^))\n (loop c^^ (cdr fns^) (length (LOF))))\n (else (loop c^ (cdr fns^) (sub1 n))))))))))\n\n(define absento\n (lambda (u v)\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((mem-check u v S) (mzero))\n (else (unit `(,B ,E ,S ,D ,Y ,N ((,u . ,v) . ,T))))))))\n\n(define eigen-absento\n (lambda (e* x*)\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((eigen-occurs-check e* x* S) (mzero))\n (else (unit `(,B ((,e* . ,x*) . ,E) ,S ,D ,Y ,N ,T)))))))\n\n(define mem-check\n (lambda (u t S)\n (let ((t (walk t S)))\n (cond\n ((pair? t)\n (or (term=? u t S)\n (mem-check u (car t) S)\n (mem-check u (cdr t) S)))\n (else (term=? u t S))))))\n\n(define term=?\n (lambda (u t S)\n (cond\n ((unify u t S) =>\n (lambda (S0)\n (eq? S0 S)))\n (else #f))))\n\n(define ground-non-?\n (lambda (pred)\n (lambda (u S)\n (let ((u (walk u S)))\n (cond\n ((var? u) #f)\n (else (not (pred u))))))))\n;; moved\n(define ground-non-symbol?\n (ground-non-? symbol?))\n\n(define ground-non-number?\n (ground-non-? number?))\n\n(define symbolo\n (lambda (u)\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((ground-non-symbol? u S) (mzero))\n ((mem-check u N S) (mzero))\n (else (unit `(,B ,E ,S ,D (,u . ,Y) ,N ,T)))))))\n\n(define numbero\n (lambda (u)\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((ground-non-number? u S) (mzero))\n ((mem-check u Y S) (mzero))\n (else (unit `(,B ,E ,S ,D ,Y (,u . ,N) ,T)))))))\n;; end moved\n\n(define =/= ;; moved\n (lambda (u v)\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((unify u v S) =>\n (lambda (S0)\n (let ((pfx (prefix-S S0 S)))\n (cond\n ((null? pfx) (mzero))\n (else (unit `(,B ,E ,S (,pfx . ,D) ,Y ,N ,T)))))))\n (else c)))))\n\n(define ==\n (lambda (u v)\n (lambdag@ (c : B E S D Y N T)\n (cond\n ((unify u v S) =>\n (lambda (S0)\n (cond\n ((==fail-check B E S0 D Y N T) (mzero))\n (else (unit `(,B ,E ,S0 ,D ,Y ,N ,T))))))\n (else (mzero))))))\n\n(define succeed (== #f #f))\n\n(define fail (== #f #t))\n\n(define ==fail-check\n (lambda (B E S0 D Y N T)\n (cond\n ((eigen-absento-fail-check E S0) #t)\n ((atomic-fail-check S0 Y ground-non-symbol?) #t)\n ((atomic-fail-check S0 N ground-non-number?) #t)\n ((symbolo-numbero-fail-check S0 Y N) #t)\n ((=/=-fail-check S0 D) #t)\n ((absento-fail-check S0 T) #t)\n (else #f))))\n\n(define eigen-absento-fail-check\n (lambda (E S0)\n (exists (lambda (e*/x*) (eigen-occurs-check (car e*/x*) (cdr e*/x*) S0)) E)))\n\n(define atomic-fail-check\n (lambda (S A pred)\n (exists (lambda (a) (pred (walk a S) S)) A)))\n\n(define symbolo-numbero-fail-check\n (lambda (S A N)\n (let ((N (map (lambda (n) (walk n S)) N)))\n (exists (lambda (a) (exists (same-var? (walk a S)) N))\n A))))\n\n(define absento-fail-check\n (lambda (S T)\n (exists (lambda (t) (mem-check (lhs t) (rhs t) S)) T)))\n\n(define =/=-fail-check\n (lambda (S D)\n (exists (d-fail-check S) D)))\n\n(define d-fail-check\n (lambda (S)\n (lambda (d)\n (cond\n ((unify* d S) =>\n\t (lambda (S+) (eq? S+ S)))\n (else #f)))))\n\n(define reify\n (lambda (x)\n (lambda (c)\n (let ((c (cycle c)))\n (let* ((S (c->S c))\n (D (walk* (c->D c) S))\n (Y (walk* (c->Y c) S))\n (N (walk* (c->N c) S))\n (T (walk* (c->T c) S)))\n (let ((v (walk* x S)))\n (let ((R (reify-S v '())))\n (reify+ v R\n (let ((D (remp\n (lambda (d)\n (let ((dw (walk* d S)))\n (or\n (anyvar? dw R)\n (anyeigen? dw R))))\n (rem-xx-from-d c))))\n (rem-subsumed D))\n (remp\n (lambda (y) (var? (walk y R)))\n Y)\n (remp\n (lambda (n) (var? (walk n R)))\n N)\n (remp (lambda (t)\n (or (anyeigen? t R) (anyvar? t R))) T)))))))))\n\n(define reify+\n (lambda (v R D Y N T)\n (form (walk* v R)\n (walk* D R)\n (walk* Y R)\n (walk* N R)\n (rem-subsumed-T (walk* T R)))))\n\n(define form\n (lambda (v D Y N T)\n (let ((fd (sort-D D))\n (fy (sorter Y))\n (fn (sorter N))\n (ft (sorter T)))\n (let ((fd (if (null? fd) fd\n (let ((fd (drop-dot-D fd)))\n `((=/= . ,fd)))))\n (fy (if (null? fy) fy `((sym . ,fy))))\n (fn (if (null? fn) fn `((num . ,fn))))\n (ft (if (null? ft) ft\n (let ((ft (drop-dot ft)))\n `((absento . ,ft))))))\n (cond\n ((and (null? fd) (null? fy)\n (null? fn) (null? ft))\n v)\n (else (append `(,v) fd fn fy ft)))))))\n\n(define sort-D\n (lambda (D)\n (sorter\n (map sort-d D))))\n\n(define sort-d\n (lambda (d)\n (list-sort\n (lambda (x y)\n (lex<=? (car x) (car y)))\n (map sort-pr d))))\n\n(define drop-dot-D\n (lambda (D)\n (map drop-dot D)))\n\n(define lex<-reified-name?\n (lambda (r)\n (charstring r) 0)\n #\\_)))\n\n(define sort-pr\n (lambda (pr)\n (let ((l (lhs pr))\n (r (rhs pr)))\n (cond\n ((lex<-reified-name? r) pr)\n ((lex<=? r l) `(,r . ,l))\n (else pr)))))\n\n(define rem-subsumed\n (lambda (D)\n (let rem-subsumed ((D D) (d^* '()))\n (cond\n ((null? D) d^*)\n ((or (subsumed? (car D) (cdr D))\n (subsumed? (car D) d^*))\n (rem-subsumed (cdr D) d^*))\n (else (rem-subsumed (cdr D)\n (cons (car D) d^*)))))))\n\n(define subsumed?\n (lambda (d d*)\n (cond\n ((null? d*) #f)\n (else\n (let ((d^ (unify* (car d*) d)))\n (or\n (and d^ (eq? d^ d))\n (subsumed? d (cdr d*))))))))\n\n(define rem-xx-from-d\n (lambdag@ (c : B E S D Y N T)\n (let ((D (walk* D S)))\n (remp not\n (map (lambda (d)\n (cond\n ((unify* d S) =>\n (lambda (S0)\n (cond\n ((==fail-check B E S0 '() Y N T) #f)\n (else (prefix-S S0 S)))))\n (else #f)))\n D)))))\n\n(define rem-subsumed-T\n (lambda (T)\n (let rem-subsumed ((T T) (T^ '()))\n (cond\n ((null? T) T^)\n (else\n (let ((lit (lhs (car T)))\n (big (rhs (car T))))\n (cond\n ((or (subsumed-T? lit big (cdr T))\n (subsumed-T? lit big T^))\n (rem-subsumed (cdr T) T^))\n (else (rem-subsumed (cdr T)\n (cons (car T) T^))))))))))\n\n(define subsumed-T?\n (lambda (lit big T)\n (cond\n ((null? T) #f)\n (else\n (let ((lit^ (lhs (car T)))\n (big^ (rhs (car T))))\n (or\n (and (eq? big big^) (member* lit^ lit))\n (subsumed-T? lit big (cdr T))))))))\n\n(define LOF\n (lambda ()\n `(,drop-N-b/c-const ,drop-Y-b/c-const ,drop-Y-b/c-dup-var\n ,drop-N-b/c-dup-var ,drop-D-b/c-Y-or-N ,drop-T-b/c-Y-and-N\n ,move-T-to-D-b/c-t2-atom ,split-t-move-to-d-b/c-pair\n ,drop-from-D-b/c-T ,drop-t-b/c-t2-occurs-t1)))\n" }, { "path": "numbero-tests.scm", "content": "(test \"numbero-1\"\n (run* (q) (numbero q))\n '((_.0 (num _.0))))\n\n(test \"numbero-2\"\n (run* (q) (numbero q) (== 5 q))\n '(5))\n\n(test \"numbero-3\"\n (run* (q) (== 5 q) (numbero q))\n '(5))\n\n(test \"numbero-4\"\n (run* (q) (== 'x q) (numbero q))\n '())\n\n(test \"numbero-5\"\n (run* (q) (numbero q) (== 'x q))\n '())\n\n(test \"numbero-6\"\n (run* (q) (numbero q) (== `(1 . 2) q))\n '())\n\n(test \"numbero-7\"\n (run* (q) (== `(1 . 2) q) (numbero q))\n '())\n\n(test \"numbero-8\"\n (run* (q) (fresh (x) (numbero x)))\n '(_.0))\n\n(test \"numbero-9\"\n (run* (q) (fresh (x) (numbero x)))\n '(_.0))\n\n(test \"numbero-10\"\n (run* (q) (fresh (x) (numbero x) (== x q)))\n '((_.0 (num _.0))))\n\n(test \"numbero-11\"\n (run* (q) (fresh (x) (numbero q) (== x q) (numbero x)))\n '((_.0 (num _.0))))\n\n(test \"numbero-12\"\n (run* (q) (fresh (x) (numbero q) (numbero x) (== x q)))\n '((_.0 (num _.0))))\n\n(test \"numbero-13\"\n (run* (q) (fresh (x) (== x q) (numbero q) (numbero x)))\n '((_.0 (num _.0))))\n\n(test \"numbero-14-a\"\n (run* (q) (fresh (x) (numbero q) (== 5 x)))\n '((_.0 (num _.0))))\n\n(test \"numbero-14-b\"\n (run* (q) (fresh (x) (numbero q) (== 5 x) (== x q)))\n '(5))\n\n(test \"numbero-15\"\n (run* (q) (fresh (x) (== q x) (numbero q) (== 'y x)))\n '())\n\n(test \"numbero-16-a\"\n (run* (q) (numbero q) (=/= 'y q))\n '((_.0 (num _.0))))\n\n(test \"numbero-16-b\"\n (run* (q) (=/= 'y q) (numbero q))\n '((_.0 (num _.0))))\n\n(test \"numbero-17\"\n (run* (q) (numbero q) (=/= `(1 . 2) q))\n '((_.0 (num _.0))))\n\n(test \"numbero-18\"\n (run* (q) (numbero q) (=/= 5 q))\n '((_.0 (=/= ((_.0 5))) (num _.0))))\n\n(test \"numbero-19\"\n (run* (q)\n (fresh (x y)\n (numbero x)\n (numbero y)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (num _.0 _.1))))\n\n(test \"numbero-20\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (numbero y)))\n '(((_.0 _.1) (num _.0 _.1))))\n\n(test \"numbero-21\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (numbero x)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-22\"\n (run* (q)\n (fresh (x y)\n (numbero x)\n (numbero x)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-23\"\n (run* (q)\n (fresh (x y)\n (numbero x)\n (== `(,x ,y) q)\n (numbero x)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-24-a\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (numbero w)\n (numbero z)))\n '(_.0))\n\n(test \"numbero-24-b\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (numbero w)\n (numbero z)\n (== `(,w ,x ,y ,z) q)))\n '(((_.0 _.1 _.2 _.3)\n (=/= ((_.0 _.2) (_.1 _.3)))\n (num _.0 _.3))))\n\n(test \"numbero-24-c\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (numbero w)\n (numbero y)\n (== `(,w ,x ,y ,z) q)))\n '(((_.0 _.1 _.2 _.3)\n (=/= ((_.0 _.2) (_.1 _.3)))\n (num _.0 _.2))))\n\n(test \"numbero-24-d\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (numbero w)\n (numbero y)\n (== w y)\n (== `(,w ,x ,y ,z) q)))\n '(((_.0 _.1 _.0 _.2)\n (=/= ((_.1 _.2)))\n (num _.0))))\n\n(test \"numbero-25\"\n (run* (q)\n (fresh (w x)\n (=/= `(,w . ,x) `(a . b))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (=/= ((_.0 a) (_.1 b))))))\n\n(test \"numbero-26\"\n (run* (q)\n (fresh (w x)\n (=/= `(,w . ,x) `(a . b))\n (numbero w)\n (== `(,w ,x) q)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-27\"\n (run* (q)\n (fresh (w x)\n (numbero w)\n (=/= `(,w . ,x) `(a . b))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-28\"\n (run* (q)\n (fresh (w x)\n (numbero w)\n (=/= `(a . b) `(,w . ,x))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-29\"\n (run* (q)\n (fresh (w x)\n (numbero w)\n (=/= `(a . ,x) `(,w . b))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"numbero-30\"\n (run* (q)\n (fresh (w x)\n (numbero w)\n (=/= `(5 . ,x) `(,w . b))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (=/= ((_.0 5) (_.1 b))) (num _.0))))\n\n(test \"numbero-31\"\n (run* (q)\n (fresh (x y z a b)\n (numbero x)\n (numbero y)\n (numbero z)\n (numbero a)\n (numbero b)\n (== `(,y ,z ,x ,b) `(,z ,x ,y ,a))\n (== q `(,x ,y ,z ,a ,b))))\n'(((_.0 _.0 _.0 _.1 _.1) (num _.0 _.1))))\n\n(test \"numbero-32\"\n (run* (q)\n (fresh (x y z a b)\n (== q `(,x ,y ,z ,a ,b))\n (== `(,y ,z ,x ,b) `(,z ,x ,y ,a))\n (numbero x)\n (numbero a)))\n '(((_.0 _.0 _.0 _.1 _.1) (num _.0 _.1))))\n" }, { "path": "numbers.scm", "content": "(define build-num\n (lambda (n)\n (cond\n ((odd? n)\n (cons 1\n (build-num (quotient (- n 1) 2))))\n ((and (not (zero? n)) (even? n))\n (cons 0\n (build-num (quotient n 2))))\n ((zero? n) '()))))\n\n(define zeroo\n (lambda (n)\n (== '() n)))\n\n(define poso\n (lambda (n)\n (fresh (a d)\n (== `(,a . ,d) n))))\n\n(define >1o\n (lambda (n)\n (fresh (a ad dd)\n (== `(,a ,ad . ,dd) n))))\n\n(define full-addero\n (lambda (b x y r c)\n (conde\n ((== 0 b) (== 0 x) (== 0 y) (== 0 r) (== 0 c))\n ((== 1 b) (== 0 x) (== 0 y) (== 1 r) (== 0 c))\n ((== 0 b) (== 1 x) (== 0 y) (== 1 r) (== 0 c))\n ((== 1 b) (== 1 x) (== 0 y) (== 0 r) (== 1 c))\n ((== 0 b) (== 0 x) (== 1 y) (== 1 r) (== 0 c))\n ((== 1 b) (== 0 x) (== 1 y) (== 0 r) (== 1 c))\n ((== 0 b) (== 1 x) (== 1 y) (== 0 r) (== 1 c))\n ((== 1 b) (== 1 x) (== 1 y) (== 1 r) (== 1 c)))))\n\n(define addero\n (lambda (d n m r)\n (conde\n ((== 0 d) (== '() m) (== n r))\n ((== 0 d) (== '() n) (== m r)\n (poso m))\n ((== 1 d) (== '() m)\n (addero 0 n '(1) r))\n ((== 1 d) (== '() n) (poso m)\n (addero 0 '(1) m r))\n ((== '(1) n) (== '(1) m)\n (fresh (a c)\n (== `(,a ,c) r)\n (full-addero d 1 1 a c)))\n ((== '(1) n) (gen-addero d n m r))\n ((== '(1) m) (>1o n) (>1o r)\n (addero d '(1) n r))\n ((>1o n) (gen-addero d n m r)))))\n\n(define gen-addero\n (lambda (d n m r)\n (fresh (a b c e x y z)\n (== `(,a . ,x) n)\n (== `(,b . ,y) m) (poso y)\n (== `(,c . ,z) r) (poso z)\n (full-addero d a b c e)\n (addero e x y z))))\n\n(define pluso\n (lambda (n m k)\n (addero 0 n m k)))\n\n(define minuso\n (lambda (n m k)\n (pluso m k n)))\n\n(define *o\n (lambda (n m p)\n (conde\n ((== '() n) (== '() p))\n ((poso n) (== '() m) (== '() p))\n ((== '(1) n) (poso m) (== m p))\n ((>1o n) (== '(1) m) (== n p))\n ((fresh (x z)\n (== `(0 . ,x) n) (poso x)\n (== `(0 . ,z) p) (poso z)\n (>1o m)\n (*o x m z)))\n ((fresh (x y)\n (== `(1 . ,x) n) (poso x)\n (== `(0 . ,y) m) (poso y)\n (*o m n p)))\n ((fresh (x y)\n (== `(1 . ,x) n) (poso x)\n (== `(1 . ,y) m) (poso y)\n (odd-*o x n m p))))))\n\n(define odd-*o\n (lambda (x n m p)\n (fresh (q)\n (bound-*o q p n m)\n (*o x m q)\n (pluso `(0 . ,q) m p))))\n\n(define bound-*o\n (lambda (q p n m)\n (conde\n ((== '() q) (poso p))\n ((fresh (a0 a1 a2 a3 x y z)\n (== `(,a0 . ,x) q)\n (== `(,a1 . ,y) p)\n (conde\n ((== '() n)\n (== `(,a2 . ,z) m)\n (bound-*o x y z '()))\n ((== `(,a3 . ,z) n) \n (bound-*o x y z m))))))))\n\n(define =lo\n (lambda (n m)\n (conde\n ((== '() n) (== '() m))\n ((== '(1) n) (== '(1) m))\n ((fresh (a x b y)\n (== `(,a . ,x) n) (poso x)\n (== `(,b . ,y) m) (poso y)\n (=lo x y))))))\n\n(define 1o m))\n ((fresh (a x b y)\n (== `(,a . ,x) n) (poso x)\n (== `(,b . ,y) m) (poso y)\n (1o b) (=lo n b) (pluso r b n))\n ((== '(1) b) (poso q) (pluso r '(1) n))\n ((== '() b) (poso q) (== r n))\n ((== '(0 1) b)\n (fresh (a ad dd)\n (poso dd)\n (== `(,a ,ad . ,dd) n)\n (exp2 n '() q)\n (fresh (s)\n (splito n dd r s))))\n ((fresh (a ad add ddd)\n (conde\n ((== '(1 1) b))\n ((== `(,a ,ad ,add . ,ddd) b))))\n (1o n) (== '(1) q)\n (fresh (s)\n (splito n b s '(1))))\n ((fresh (q1 b2)\n (== `(0 . ,q1) q)\n (poso q1)\n (1o q)\n (fresh (q1 nq1)\n (pluso q1 '(1) q)\n (repeated-mul n q1 nq1)\n (*o nq1 n nq))))))\n\n(define expo\n (lambda (b q n)\n (logo n b q '())))\n\n" }, { "path": "symbolo-numbero-tests.scm", "content": "(test \"symbolo-numbero-1\"\n (run* (q) (symbolo q) (numbero q))\n '())\n\n(test \"symbolo-numbero-2\"\n (run* (q) (numbero q) (symbolo q))\n '())\n\n(test \"symbolo-numbero-3\"\n (run* (q)\n (fresh (x)\n (numbero x)\n (symbolo x)))\n '())\n\n(test \"symbolo-numbero-4\"\n (run* (q)\n (fresh (x)\n (symbolo x)\n (numbero x)))\n '())\n\n(test \"symbolo-numbero-5\"\n (run* (q)\n (numbero q)\n (fresh (x)\n (symbolo x)\n (== x q)))\n '())\n\n(test \"symbolo-numbero-6\"\n (run* (q)\n (symbolo q)\n (fresh (x)\n (numbero x)\n (== x q)))\n '())\n\n(test \"symbolo-numbero-7\"\n (run* (q)\n (fresh (x)\n (numbero x)\n (== x q))\n (symbolo q))\n '())\n\n(test \"symbolo-numbero-7\"\n (run* (q)\n (fresh (x)\n (symbolo x)\n (== x q))\n (numbero q))\n '())\n\n(test \"symbolo-numbero-8\"\n (run* (q)\n (fresh (x)\n (== x q)\n (symbolo x))\n (numbero q))\n '())\n\n(test \"symbolo-numbero-9\"\n (run* (q)\n (fresh (x)\n (== x q)\n (numbero x))\n (symbolo q))\n '())\n\n(test \"symbolo-numbero-10\"\n (run* (q)\n (symbolo q)\n (fresh (x)\n (numbero x)))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-numbero-11\"\n (run* (q)\n (numbero q)\n (fresh (x)\n (symbolo x)))\n '((_.0 (num _.0))))\n\n(test \"symbolo-numbero-12\"\n (run* (q) \n (fresh (x y)\n (symbolo x)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-numbero-13\"\n (run* (q) \n (fresh (x y)\n (numbero x)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (num _.0))))\n\n(test \"symbolo-numbero-14\"\n (run* (q) \n (fresh (x y)\n (numbero x)\n (symbolo y)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (num _.0) (sym _.1))))\n\n(test \"symbolo-numbero-15\"\n (run* (q) \n (fresh (x y)\n (numbero x)\n (== `(,x ,y) q)\n (symbolo y)))\n '(((_.0 _.1) (num _.0) (sym _.1))))\n\n(test \"symbolo-numbero-16\"\n (run* (q) \n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (symbolo y)))\n '(((_.0 _.1) (num _.0) (sym _.1))))\n\n(test \"symbolo-numbero-17\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (symbolo y))\n (fresh (w z)\n (== `(,w ,z) q)))\n '(((_.0 _.1) (num _.0) (sym _.1))))\n\n(test \"symbolo-numbero-18\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (symbolo y))\n (fresh (w z)\n (== `(,w ,z) q)\n (== w 5)))\n '(((5 _.0) (sym _.0))))\n\n(test \"symbolo-numbero-19\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (symbolo y))\n (fresh (w z)\n (== 'a z)\n (== `(,w ,z) q)))\n '(((_.0 a) (num _.0))))\n\n(test \"symbolo-numbero-20\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero x)\n (symbolo y))\n (fresh (w z)\n (== `(,w ,z) q)\n (== 'a z)))\n '(((_.0 a) (num _.0))))\n\n(test \"symbolo-numbero-21\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= `(5 a) q)))\n '(((_.0 _.1) (=/= ((_.0 5) (_.1 a))))))\n\n(test \"symbolo-numbero-22\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= `(5 a) q)\n (symbolo x)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-numbero-23\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (symbolo x)\n (=/= `(5 a) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-numbero-24\"\n (run* (q)\n (fresh (x y)\n (symbolo x)\n (== `(,x ,y) q)\n (=/= `(5 a) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-numbero-25\"\n (run* (q)\n (fresh (x y)\n (=/= `(5 a) q)\n (symbolo x)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-numbero-26\"\n (run* (q)\n (fresh (x y)\n (=/= `(5 a) q)\n (== `(,x ,y) q)\n (symbolo x)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-numbero-27\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (=/= `(5 a) q)\n (numbero y)))\n '(((_.0 _.1) (num _.1))))\n\n(test \"symbolo-numbero-28\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (numbero y)\n (=/= `(5 a) q)))\n '(((_.0 _.1) (num _.1))))\n\n(test \"symbolo-numbero-29\"\n (run* (q)\n (fresh (x y)\n (numbero y)\n (== `(,x ,y) q)\n (=/= `(5 a) q)))\n '(((_.0 _.1) (num _.1))))\n\n(test \"symbolo-numbero-30\"\n (run* (q)\n (fresh (x y)\n (=/= `(5 a) q)\n (numbero y)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (num _.1))))\n\n(test \"symbolo-numbero-31\"\n (run* (q)\n (fresh (x y)\n (=/= `(5 a) q)\n (== `(,x ,y) q)\n (numbero y)))\n '(((_.0 _.1) (num _.1))))\n\n(test \"symbolo-numbero-32\"\n (run* (q)\n (fresh (x y)\n (=/= `(,x ,y) q)\n (numbero x)\n (symbolo y)))\n '(_.0))\n\n(test \"symbolo-numbero-33\"\n (run* (q)\n (fresh (x y)\n (numbero x)\n (=/= `(,x ,y) q)\n (symbolo y)))\n '(_.0))\n\n(test \"symbolo-numbero-34\"\n (run* (q)\n (fresh (x y)\n (numbero x)\n (symbolo y)\n (=/= `(,x ,y) q)))\n '(_.0))\n" }, { "path": "symbolo-tests.scm", "content": "(test \"symbolo-1\"\n (run* (q) (symbolo q))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-2\"\n (run* (q) (symbolo q) (== 'x q))\n '(x))\n\n(test \"symbolo-3\"\n (run* (q) (== 'x q) (symbolo q))\n '(x))\n\n(test \"symbolo-4\"\n (run* (q) (== 5 q) (symbolo q))\n '())\n\n(test \"symbolo-5\"\n (run* (q) (symbolo q) (== 5 q))\n '())\n\n(test \"symbolo-6\"\n (run* (q) (symbolo q) (== `(1 . 2) q))\n '())\n\n(test \"symbolo-7\"\n (run* (q) (== `(1 . 2) q) (symbolo q))\n '())\n\n(test \"symbolo-8\"\n (run* (q) (fresh (x) (symbolo x)))\n '(_.0))\n\n(test \"symbolo-9\"\n (run* (q) (fresh (x) (symbolo x)))\n '(_.0))\n\n(test \"symbolo-10\"\n (run* (q) (fresh (x) (symbolo x) (== x q)))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-11\"\n (run* (q) (fresh (x) (symbolo q) (== x q) (symbolo x)))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-12\"\n (run* (q) (fresh (x) (symbolo q) (symbolo x) (== x q)))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-13\"\n (run* (q) (fresh (x) (== x q) (symbolo q) (symbolo x)))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-14-a\"\n (run* (q) (fresh (x) (symbolo q) (== 'y x)))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-14-b\"\n (run* (q) (fresh (x) (symbolo q) (== 'y x) (== x q)))\n '(y))\n\n(test \"symbolo-15\"\n (run* (q) (fresh (x) (== q x) (symbolo q) (== 5 x)))\n '())\n\n(test \"symbolo-16-a\"\n (run* (q) (symbolo q) (=/= 5 q))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-16-b\"\n (run* (q) (=/= 5 q) (symbolo q))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-17\"\n (run* (q) (symbolo q) (=/= `(1 . 2) q))\n '((_.0 (sym _.0))))\n\n(test \"symbolo-18\"\n (run* (q) (symbolo q) (=/= 'y q))\n '((_.0 (=/= ((_.0 y))) (sym _.0))))\n\n(test \"symbolo-19\"\n (run* (q)\n (fresh (x y)\n (symbolo x)\n (symbolo y)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (sym _.0 _.1))))\n\n(test \"symbolo-20\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (symbolo x)\n (symbolo y)))\n '(((_.0 _.1) (sym _.0 _.1))))\n\n(test \"symbolo-21\"\n (run* (q)\n (fresh (x y)\n (== `(,x ,y) q)\n (symbolo x)\n (symbolo x)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-22\"\n (run* (q)\n (fresh (x y)\n (symbolo x)\n (symbolo x)\n (== `(,x ,y) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-23\"\n (run* (q)\n (fresh (x y)\n (symbolo x)\n (== `(,x ,y) q)\n (symbolo x)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-24-a\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (symbolo w)\n (symbolo z)))\n '(_.0))\n\n(test \"symbolo-24-b\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (symbolo w)\n (symbolo z)\n (== `(,w ,x ,y ,z) q)))\n '(((_.0 _.1 _.2 _.3)\n (=/= ((_.0 _.2) (_.1 _.3)))\n (sym _.0 _.3))))\n\n(test \"symbolo-24-c\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (symbolo w)\n (symbolo y)\n (== `(,w ,x ,y ,z) q)))\n '(((_.0 _.1 _.2 _.3)\n (=/= ((_.0 _.2) (_.1 _.3)))\n (sym _.0 _.2))))\n\n(test \"symbolo-24-d\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w . ,x) `(,y . ,z))\n (symbolo w)\n (symbolo y)\n (== w y)\n (== `(,w ,x ,y ,z) q)))\n '(((_.0 _.1 _.0 _.2)\n (=/= ((_.1 _.2)))\n (sym _.0))))\n\n(test \"symbolo-25\"\n (run* (q)\n (fresh (w x)\n (=/= `(,w . ,x) `(5 . 6))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (=/= ((_.0 5) (_.1 6))))))\n\n(test \"symbolo-26\"\n (run* (q)\n (fresh (w x)\n (=/= `(,w . ,x) `(5 . 6))\n (symbolo w)\n (== `(,w ,x) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-27\"\n (run* (q)\n (fresh (w x)\n (symbolo w)\n (=/= `(,w . ,x) `(5 . 6))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-28\"\n (run* (q)\n (fresh (w x)\n (symbolo w)\n (=/= `(5 . 6) `(,w . ,x))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-29\"\n (run* (q)\n (fresh (w x)\n (symbolo w)\n (=/= `(5 . ,x) `(,w . 6))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (sym _.0))))\n\n(test \"symbolo-30\"\n (run* (q)\n (fresh (w x)\n (symbolo w)\n (=/= `(z . ,x) `(,w . 6))\n (== `(,w ,x) q)))\n '(((_.0 _.1) (=/= ((_.0 z) (_.1 6))) (sym _.0))))\n\n(test \"symbolo-31-a\"\n (run* (q)\n (fresh (w x y z)\n (== x 5)\n (=/= `(,w ,y) `(,x ,z))\n (== w 5)\n (== `(,w ,x ,y ,z) q)))\n '(((5 5 _.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"symbolo-31-b\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w ,y) `(,x ,z))\n (== w 5)\n (== x 5)\n (== `(,w ,x ,y ,z) q)))\n '(((5 5 _.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"symbolo-31-c\"\n (run* (q)\n (fresh (w x y z)\n (== w 5)\n (=/= `(,w ,y) `(,x ,z))\n (== `(,w ,x ,y ,z) q)\n (== x 5)))\n '(((5 5 _.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"symbolo-31-d\"\n (run* (q)\n (fresh (w x y z)\n (== w 5)\n (== x 5)\n (=/= `(,w ,y) `(,x ,z))\n (== `(,w ,x ,y ,z) q)))\n '(((5 5 _.0 _.1) (=/= ((_.0 _.1))))))\n\n\n(test \"symbolo-32-a\"\n (run* (q)\n (fresh (w x y z)\n (== x 'a)\n (=/= `(,w ,y) `(,x ,z))\n (== w 'a)\n (== `(,w ,x ,y ,z) q)))\n '(((a a _.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"symbolo-32-b\"\n (run* (q)\n (fresh (w x y z)\n (=/= `(,w ,y) `(,x ,z))\n (== w 'a)\n (== x 'a)\n (== `(,w ,x ,y ,z) q)))\n '(((a a _.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"symbolo-32-c\"\n (run* (q)\n (fresh (w x y z)\n (== w 'a)\n (=/= `(,w ,y) `(,x ,z))\n (== `(,w ,x ,y ,z) q)\n (== x 'a)))\n '(((a a _.0 _.1) (=/= ((_.0 _.1))))))\n\n(test \"symbolo-32-d\"\n (run* (q)\n (fresh (w x y z)\n (== w 'a)\n (== x 'a)\n (=/= `(,w ,y) `(,x ,z))\n (== `(,w ,x ,y ,z) q)))\n '(((a a _.0 _.1) (=/= ((_.0 _.1))))))\n" }, { "path": "test-all.scm", "content": "(load \"test-check.scm\")\n\n(printf \"==-tests\\n\")\n(load \"==-tests.scm\")\n\n(printf \"symbolo-tests\\n\")\n(load \"symbolo-tests.scm\")\n\n(printf \"numbero-tests\\n\")\n(load \"numbero-tests.scm\")\n\n(printf \"symbolo-numbero-tests\\n\")\n(load \"symbolo-numbero-tests.scm\")\n\n(printf \"disequality-tests\\n\")\n(load \"disequality-tests.scm\")\n\n(printf \"absento-closure-tests\\n\")\n(load \"absento-closure-tests.scm\")\n\n(printf \"absento-tests\\n\")\n(load \"absento-tests.scm\")\n\n(printf \"test-infer\\n\")\n(load \"test-infer.scm\")\n\n(printf \"test-interp\\n\")\n(load \"test-interp.scm\")\n\n(printf \"test-quines\\n\")\n(load \"test-quines.scm\")\n\n(printf \"test-numbers\\n\")\n(load \"numbers.scm\")\n(load \"test-numbers.scm\")\n" }, { "path": "test-check.scm", "content": "(define-syntax test\n (syntax-rules ()\n ((_ title tested-expression expected-result)\n (begin\n (printf \"Testing ~s\\n\" title)\n (let* ((expected expected-result)\n (produced tested-expression))\n (or (equal? expected produced)\n (printf \"Failed: ~a~%Expected: ~a~%Computed: ~a~%\"\n 'tested-expression expected produced)))))))\n" }, { "path": "test-infer.scm", "content": "(define !-\n (lambda (exp env t)\n (conde\n [(symbolo exp) (lookupo exp env t)]\n [(fresh (x e t-x t-e)\n (== `(lambda (,x) ,e) exp)\n (symbolo x)\n (not-in-envo 'lambda env)\n (== `(-> ,t-x ,t-e) t)\n (!- e `((,x . ,t-x) . ,env) t-e))]\n [(fresh (rator rand t-x)\n (== `(,rator ,rand) exp)\n (!- rator env `(-> ,t-x ,t))\n (!- rand env t-x))])))\n\n(define lookupo\n (lambda (x env t)\n (fresh (rest y v)\n (== `((,y . ,v) . ,rest) env)\n (conde\n ((== y x) (== v t))\n ((=/= y x) (lookupo x rest t))))))\n\n(define not-in-envo\n (lambda (x env)\n (conde\n ((== '() env))\n ((fresh (y v rest)\n (== `((,y . ,v) . ,rest) env)\n (=/= y x)\n (not-in-envo x rest))))))\n\n(test \"types\"\n (run 10 (q) (fresh (t exp) (!- exp '() t) (== `(,exp => ,t) q)))\n '((((lambda (_.0) _.0) => (-> _.1 _.1)) (sym _.0))\n (((lambda (_.0) (lambda (_.1) _.1))\n =>\n (-> _.2 (-> _.3 _.3)))\n (=/= ((_.0 lambda)))\n (sym _.0 _.1))\n (((lambda (_.0) (lambda (_.1) _.0))\n =>\n (-> _.2 (-> _.3 _.2)))\n (=/= ((_.0 _.1)) ((_.0 lambda)))\n (sym _.0 _.1))\n ((((lambda (_.0) _.0) (lambda (_.1) _.1)) => (-> _.2 _.2))\n (sym _.0 _.1))\n (((lambda (_.0) (lambda (_.1) (lambda (_.2) _.2)))\n =>\n (-> _.3 (-> _.4 (-> _.5 _.5))))\n (=/= ((_.0 lambda)) ((_.1 lambda)))\n (sym _.0 _.1 _.2))\n (((lambda (_.0) (lambda (_.1) (lambda (_.2) _.1)))\n =>\n (-> _.3 (-> _.4 (-> _.5 _.4))))\n (=/= ((_.0 lambda)) ((_.1 _.2)) ((_.1 lambda)))\n (sym _.0 _.1 _.2))\n (((lambda (_.0) (_.0 (lambda (_.1) _.1)))\n =>\n (-> (-> (-> _.2 _.2) _.3) _.3))\n (=/= ((_.0 lambda)))\n (sym _.0 _.1))\n (((lambda (_.0) (lambda (_.1) (lambda (_.2) _.0)))\n =>\n (-> _.3 (-> _.4 (-> _.5 _.3))))\n (=/= ((_.0 _.1)) ((_.0 _.2)) ((_.0 lambda)) ((_.1 lambda)))\n (sym _.0 _.1 _.2))\n (((lambda (_.0) (lambda (_.1) (_.1 _.0)))\n =>\n (-> _.2 (-> (-> _.2 _.3) _.3)))\n (=/= ((_.0 _.1)) ((_.0 lambda)))\n (sym _.0 _.1))\n ((((lambda (_.0) _.0) (lambda (_.1) (lambda (_.2) _.2)))\n =>\n (-> _.3 (-> _.4 _.4)))\n (=/= ((_.1 lambda)))\n (sym _.0 _.1 _.2))))\n" }, { "path": "test-interp.scm", "content": "(define eval-expo\n (lambda (exp env val)\n (conde\n ((fresh (rator rand x body env^ a)\n (== `(,rator ,rand) exp)\n (eval-expo rator env `(closure ,x ,body ,env^))\n (eval-expo rand env a)\n (eval-expo body `((,x . ,a) . ,env^) val)))\n ((fresh (x body)\n (== `(lambda (,x) ,body) exp)\n (symbolo x)\n (== `(closure ,x ,body ,env) val)\n (not-in-envo 'lambda env)))\n ((symbolo exp) (lookupo exp env val)))))\n\n(define not-in-envo\n (lambda (x env)\n (conde\n ((== '() env))\n ((fresh (y v rest)\n (== `((,y . ,v) . ,rest) env)\n (=/= y x)\n (not-in-envo x rest))))))\n\n(define lookupo\n (lambda (x env t)\n (conde\n ((fresh (y v rest)\n (== `((,y . ,v) . ,rest) env) (== y x)\n (== v t)))\n ((fresh (y v rest)\n (== `((,y . ,v) . ,rest) env) (=/= y x)\n (lookupo x rest t))))))\n\n(test \"running backwards\"\n (run 5 (q) (eval-expo q '() '(closure y x ((x . (closure z z ()))))))\n '(((lambda (x) (lambda (y) x)) (lambda (z) z))\n ((lambda (x) (x (lambda (y) x))) (lambda (z) z))\n (((lambda (x) (lambda (y) x))\n ((lambda (_.0) _.0) (lambda (z) z)))\n (sym _.0))\n (((lambda (_.0) _.0)\n ((lambda (x) (lambda (y) x)) (lambda (z) z)))\n (sym _.0))\n ((((lambda (_.0) _.0) (lambda (x) (lambda (y) x)))\n (lambda (z) z))\n (sym _.0))))\n\n(define lookupo\n (lambda (x env t)\n (fresh (rest y v)\n (== `((,y . ,v) . ,rest) env)\n (conde\n ((== y x) (== v t))\n ((=/= y x) (lookupo x rest t))))))\n\n(test \"eval-exp-lc 1\"\n (run* (q) (eval-expo '(((lambda (x) (lambda (y) x)) (lambda (z) z)) (lambda (a) a)) '() q))\n '((closure z z ())))\n\n(test \"eval-exp-lc 2\"\n (run* (q) (eval-expo '((lambda (x) (lambda (y) x)) (lambda (z) z)) '() q))\n '((closure y x ((x . (closure z z ()))))))\n\n(test \"running backwards\"\n (run 5 (q) (eval-expo q '() '(closure y x ((x . (closure z z ()))))))\n '(((lambda (x) (lambda (y) x)) (lambda (z) z))\n ((lambda (x) (x (lambda (y) x))) (lambda (z) z))\n (((lambda (x) (lambda (y) x))\n ((lambda (_.0) _.0) (lambda (z) z)))\n (sym _.0))\n ((((lambda (_.0) _.0) (lambda (x) (lambda (y) x)))\n (lambda (z) z))\n (sym _.0))\n (((lambda (_.0) _.0)\n ((lambda (x) (lambda (y) x)) (lambda (z) z)))\n (sym _.0))))\n\n(test \"fully-running-backwards\"\n (run 5 (q)\n (fresh (e v)\n (eval-expo e '() v)\n (== `(,e ==> ,v) q)))\n '((((lambda (_.0) _.1)\n ==> (closure _.0 _.1 ())) (sym _.0))\n ((((lambda (_.0) _.0) (lambda (_.1) _.2))\n ==>\n (closure _.1 _.2 ()))\n (sym _.0 _.1))\n ((((lambda (_.0) (lambda (_.1) _.2)) (lambda (_.3) _.4))\n ==>\n (closure _.1 _.2 ((_.0 . (closure _.3 _.4 ())))))\n (=/= ((_.0 lambda)))\n (sym _.0 _.1 _.3))\n ((((lambda (_.0) (_.0 _.0)) (lambda (_.1) _.1))\n ==>\n (closure _.1 _.1 ()))\n (sym _.0 _.1))\n ((((lambda (_.0) (_.0 _.0))\n (lambda (_.1) (lambda (_.2) _.3)))\n ==>\n (closure _.2 _.3 ((_.1 . (closure _.1 (lambda (_.2) _.3) ())))))\n (=/= ((_.1 lambda)))\n (sym _.0 _.1 _.2))))\n\n\n" }, { "path": "test-numbers.scm", "content": "(test \"test 1\"\n (run* (q) (*o (build-num 2) (build-num 3) q))\n '((0 1 1)))\n\n(test \"test 2\"\n (run* (q)\n\t(fresh (n m) \n\t (*o n m (build-num 6))\n\t (== `(,n ,m) q)))\n '(((1) (0 1 1)) ((0 1 1) (1)) ((0 1) (1 1)) ((1 1) (0 1))))\n\n(test \"sums\"\n (run 5 (q)\n (fresh (x y z)\n (pluso x y z)\n (== `(,x ,y ,z) q)))\n '((_.0 () _.0)\n (() (_.0 . _.1) (_.0 . _.1))\n ((1) (1) (0 1))\n ((1) (0 _.0 . _.1) (1 _.0 . _.1))\n ((1) (1 1) (0 0 1))))\n\n(test \"factors\"\n (run* (q)\n (fresh (x y)\n (*o x y (build-num 24))\n (== `(,x ,y ,(build-num 24)) q)))\n '(((1) (0 0 0 1 1) (0 0 0 1 1))\n ((0 0 0 1 1) (1) (0 0 0 1 1))\n ((0 1) (0 0 1 1) (0 0 0 1 1))\n ((0 0 1) (0 1 1) (0 0 0 1 1))\n ((0 0 0 1) (1 1) (0 0 0 1 1))\n ((1 1) (0 0 0 1) (0 0 0 1 1))\n ((0 1 1) (0 0 1) (0 0 0 1 1))\n ((0 0 1 1) (0 1) (0 0 0 1 1))))\n\n(define number-primo\n (lambda (exp env val)\n (fresh (n)\n (== `(intexp ,n) exp)\n (== `(intval ,n) val)\n (not-in-envo 'numo env))))\n\n(define sub1-primo\n (lambda (exp env val)\n (fresh (e n n-1)\n (== `(sub1 ,e) exp)\n (== `(intval ,n-1) val)\n (not-in-envo 'sub1 env)\n (eval-expo e env `(intval ,n))\n (minuso n '(1) n-1))))\n\n(define zero?-primo\n (lambda (exp env val)\n (fresh (e n)\n (== `(zero? ,e) exp)\n (conde\n ((zeroo n) (== #t val))\n ((poso n) (== #f val)))\n (not-in-envo 'zero? env)\n (eval-expo e env `(intval ,n)))))\n\n(define *-primo\n (lambda (exp env val)\n (fresh (e1 e2 n1 n2 n3)\n (== `(* ,e1 ,e2) exp)\n (== `(intval ,n3) val)\n (not-in-envo '* env)\n (eval-expo e1 env `(intval ,n1))\n (eval-expo e2 env `(intval ,n2))\n (*o n1 n2 n3))))\n\n(define if-primo\n (lambda (exp env val)\n (fresh (e1 e2 e3 t)\n (== `(if ,e1 ,e2 ,e3) exp)\n (not-in-envo 'if env)\n (eval-expo e1 env t)\n (conde\n ((== #t t) (eval-expo e2 env val))\n ((== #f t) (eval-expo e3 env val))))))\n\n(define boolean-primo\n (lambda (exp env val)\n (conde\n ((== #t exp) (== #t val))\n ((== #f exp) (== #f val)))))\n\n(define eval-expo\n (lambda (exp env val)\n (conde\n ((boolean-primo exp env val))\n ((number-primo exp env val))\n ((sub1-primo exp env val))\n ((zero?-primo exp env val))\n ((*-primo exp env val))\n ((if-primo exp env val))\n ((symbolo exp) (lookupo exp env val))\n ((fresh (rator rand x body env^ a)\n (== `(,rator ,rand) exp)\n (eval-expo rator env `(closure ,x ,body ,env^))\n (eval-expo rand env a)\n (eval-expo body `((,x . ,a) . ,env^) val)))\n ((fresh (x body)\n (== `(lambda (,x) ,body) exp)\n (symbolo x)\n (== `(closure ,x ,body ,env) val)\n (not-in-envo 'lambda env))))))\n\n(define not-in-envo\n (lambda (x env)\n (conde\n ((fresh (y v rest)\n (== `((,y . ,v) . ,rest) env)\n (=/= y x)\n (not-in-envo x rest)))\n ((== '() env)))))\n\n(define lookupo\n (lambda (x env t)\n (fresh (rest y v)\n (== `((,y . ,v) . ,rest) env)\n (conde\n ((== y x) (== v t))\n ((=/= y x) (lookupo x rest t))))))\n\n(test \"push-down problems 2\"\n (run* (q)\n\t(fresh (x a d)\n\t (absento 'intval x)\n\t (== 'intval a)\n\t (== `(,a . ,d) x)))\n '())\n\n(test \"push-down problems 3\"\n (run* (q)\n\t(fresh (x a d)\n\t (== `(,a . ,d) x)\n\t (absento 'intval x)\n\t (== 'intval a)))\n '())\n\n(test \"push-down problems 4\"\n (run* (q)\n\t(fresh (x a d)\n\t (== `(,a . ,d) x)\n\t (== 'intval a)\n\t (absento 'intval x)))\n '())\n\n(test \"push-down problems 6\"\n (run* (q)\n\t(fresh (x a d)\n\t (== 'intval a)\n\t (== `(,a . ,d) x)\n\t (absento 'intval x)))\n '())\n\n(test \"push-down problems 1\"\n (run* (q)\n\t(fresh (x a d)\n\t (absento 'intval x)\n\t (== `(,a . ,d) x)\n\t (== 'intval a)))\n '())\n\n(test \"push-down problems 5\"\n (run* (q)\n\t(fresh (x a d)\n\t (== 'intval a)\n\t (absento 'intval x)\n\t (== `(,a . ,d) x)))\n '())\n\n(test \"zero?\"\n (run 1 (q)\n (eval-expo `(zero? (sub1 (intexp ,(build-num 1)))) '() q))\n '(#t))\n\n(test \"*\"\n (run 1 (q)\n (eval-expo `(* (intexp ,(build-num 3)) (intexp ,(build-num 2))) '() `(intval ,(build-num 6))))\n '(_.0))\n\n(test \"sub1\"\n (run 1 (q)\n (eval-expo q '() `(intval ,(build-num 6))) (== `(sub1 (intexp ,(build-num 7))) q))\n '((sub1 (intexp (1 1 1)))))\n\n(test \"sub1 bigger WAIT a minute\"\n (run 1 (q)\n (eval-expo q '() `(intval ,(build-num 6)))\n (== `(sub1 (sub1 (intexp ,(build-num 8)))) q))\n '((sub1 (sub1 (intexp (0 0 0 1))))))\n\n(test \"sub1 biggest WAIT a minute\"\n (run 1 (q)\n (eval-expo q '() `(intval ,(build-num 6)))\n (== `(sub1 (sub1 (sub1 (intexp ,(build-num 9))))) q))\n '((sub1 (sub1 (sub1 (intexp (1 0 0 1)))))))\n\n(test \"lots of programs to make a 6\"\n (run 12 (q) (eval-expo q '() `(intval ,(build-num 6))))\n '((intexp (0 1 1)) (sub1 (intexp (1 1 1)))\n (* (intexp (1)) (intexp (0 1 1)))\n (* (intexp (0 1 1)) (intexp (1)))\n (if #t (intexp (0 1 1)) _.0)\n (* (intexp (0 1)) (intexp (1 1)))\n (if #f _.0 (intexp (0 1 1)))\n (sub1 (* (intexp (1)) (intexp (1 1 1))))\n (((lambda (_.0) (intexp (0 1 1))) #t)\n (=/= ((_.0 numo)))\n (sym _.0))\n (sub1 (* (intexp (1 1 1)) (intexp (1))))\n (sub1 (sub1 (intexp (0 0 0 1))))\n (sub1 (if #t (intexp (1 1 1)) _.0))))\n\n(define rel-fact5\n `((lambda (f)\n ((f f) (intexp ,(build-num 5))))\n (lambda (f)\n (lambda (n)\n (if (zero? n)\n (intexp ,(build-num 1))\n (* n ((f f) (sub1 n))))))))\n\n(test \"rel-fact5\" \n (run* (q) (eval-expo rel-fact5 '() q))\n `((intval ,(build-num 120))))\n\n(test \"rel-fact5-backwards\" \n (run 1 (q)\n (eval-expo\n `((lambda (f)\n ((f ,q) (intexp ,(build-num 5))))\n (lambda (f)\n (lambda (n)\n (if (zero? n)\n (intexp ,(build-num 1))\n (* n ((f f) (sub1 n)))))))\n '()\n `(intval ,(build-num 120))))\n `(f))\n" }, { "path": "test-quines.scm", "content": "(define eval-expo\n (lambda (exp env val)\n (conde\n ((fresh (v)\n (== `(quote ,v) exp)\n (not-in-envo 'quote env)\n (absento 'closure v)\n (== v val)))\n ((fresh (a*)\n (== `(list . ,a*) exp)\n (not-in-envo 'list env)\n (absento 'closure a*)\n (proper-listo a* env val)))\n ((symbolo exp) (lookupo exp env val))\n ((fresh (rator rand x body env^ a)\n (== `(,rator ,rand) exp)\n (eval-expo rator env `(closure ,x ,body ,env^))\n (eval-expo rand env a)\n (eval-expo body `((,x . ,a) . ,env^) val)))\n ((fresh (x body)\n (== `(lambda (,x) ,body) exp)\n (symbolo x)\n (not-in-envo 'lambda env)\n (== `(closure ,x ,body ,env) val))))))\n\n(define not-in-envo\n (lambda (x env)\n (conde\n ((fresh (y v rest)\n (== `((,y . ,v) . ,rest) env)\n (=/= y x)\n (not-in-envo x rest)))\n ((== '() env)))))\n\n(define proper-listo\n (lambda (exp env val)\n (conde\n ((== '() exp)\n (== '() val))\n ((fresh (a d t-a t-d)\n (== `(,a . ,d) exp)\n (== `(,t-a . ,t-d) val)\n (eval-expo a env t-a)\n (proper-listo d env t-d))))))\n\n(define lookupo\n (lambda (x env t)\n (fresh (rest y v)\n (== `((,y . ,v) . ,rest) env)\n (conde\n ((== y x) (== v t))\n ((=/= y x) (lookupo x rest t))))))\n\n(test \"1 quine\"\n (run 1 (q) (eval-expo q '() q))\n '((((lambda (_.0) (list _.0 (list 'quote _.0)))\n '(lambda (_.0) (list _.0 (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))))\n\n (test \"2 quines\"\n (run 2 (q) (eval-expo q '() q))\n '((((lambda (_.0) (list _.0 (list 'quote _.0)))\n '(lambda (_.0) (list _.0 (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))))\n\n (test \"3 quines\"\n (run 3 (q) (eval-expo q '() q))\n '((((lambda (_.0) (list _.0 (list 'quote _.0)))\n '(lambda (_.0) (list _.0 (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))))\n\n (test \"5 quines\"\n (run 5 (q) (eval-expo q '() q))\n '((((lambda (_.0) (list _.0 (list 'quote _.0)))\n '(lambda (_.0) (list _.0 (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list (list 'lambda '(_.0) _.0) (list 'quote _.0)))\n '(list (list 'lambda '(_.0) _.0) (list 'quote _.0)))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))))\n\n (test \"10 quines\"\n (run 10 (q) (eval-expo q '() q))\n '((((lambda (_.0) (list _.0 (list 'quote _.0)))\n '(lambda (_.0) (list _.0 (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list (list 'lambda '(_.0) _.0) (list 'quote _.0)))\n '(list (list 'lambda '(_.0) _.0) (list 'quote _.0)))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2))\n '(lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2)))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2))))\n '(lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2)))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0))\n '(lambda (_.0)\n ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0)))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0)))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))))\n\n (test \"40 quines\"\n (run 40 (q) (eval-expo q '() q))\n '((((lambda (_.0) (list _.0 (list 'quote _.0)))\n '(lambda (_.0) (list _.0 (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) '_.2) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list (list 'lambda '(_.0) _.0) (list 'quote _.0)))\n '(list (list 'lambda '(_.0) _.0) (list 'quote _.0)))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) _.1) 'quote) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2))\n '(lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) '_.2)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2)))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) '_.2))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2))))\n '(lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) '_.2)))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0))\n '(lambda (_.0)\n ((lambda (_.1) (list _.1 (list 'quote _.1))) _.0)))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0)))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.1)) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n ((lambda (_.1) (list _.0 (list _.1 _.0))) 'quote))\n '(lambda (_.0)\n ((lambda (_.1) (list _.0 (list _.1 _.0))) 'quote)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list _.1 _.0)) 'quote)))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list _.1 _.0)) 'quote))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.1) _.0))))\n '(lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.1) _.0)))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list ((lambda (_.3) 'quote) '_.4) _.0)))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list ((lambda (_.3) 'quote) '_.4) _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) ((_.3 quote)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2) (closure _.4)))\n (((lambda (_.0)\n (list ((lambda (_.1) _.1) _.0) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.1) _.0) (list 'quote _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) _.0))))\n '(lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) _.0)))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) _.0)))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n ((lambda (_.1) (list _.1 (list 'quote _.0))) _.0))\n '(lambda (_.0)\n ((lambda (_.1) (list _.1 (list 'quote _.0))) _.0)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) _.0) _.0)))\n '(lambda (_.0)\n (list _.0 (list ((lambda (_.1) 'quote) _.0) _.0))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list ((lambda (_.3) _.3) 'quote) _.0)))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list ((lambda (_.3) _.3) 'quote) _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.3 closure)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list 'quote _.0)) '_.4)))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list 'quote _.0)) '_.4))))\n (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure))\n ((_.3 list)) ((_.3 quote)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2) (closure _.4)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list 'quote ((lambda (_.3) _.0) '_.4))))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list 'quote ((lambda (_.3) _.0) '_.4)))))\n (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2) (closure _.4)))\n (((lambda (_.0)\n (list\n _.0\n (list\n ((lambda (_.1) 'quote) '_.2)\n ((lambda (_.3) _.0) '_.4))))\n '(lambda (_.0)\n (list\n _.0\n (list\n ((lambda (_.1) 'quote) '_.2)\n ((lambda (_.3) _.0) '_.4)))))\n (=/= ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)) ((_.3 closure)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2) (closure _.4)))\n (((lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.1))) _.0))\n '(lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.1))) _.0)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) (list)))))\n '(lambda (_.0)\n (list _.0 (list 'quote ((lambda (_.1) _.0) (list))))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list\n (list 'lambda '(_.0) _.0)\n (list ((lambda (_.1) 'quote) '_.2) _.0)))\n '(list\n (list 'lambda '(_.0) _.0)\n (list ((lambda (_.1) 'quote) '_.2) _.0)))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n ((lambda (_.1)\n (list ((lambda (_.2) _.0) '_.3) (list 'quote _.0)))\n '_.4))\n '(lambda (_.0)\n ((lambda (_.1)\n (list ((lambda (_.2) _.0) '_.3) (list 'quote _.0)))\n '_.4)))\n (=/= ((_.0 _.1)) ((_.0 _.2)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.1 lambda))\n ((_.1 list)) ((_.1 quote)) ((_.2 closure)))\n (sym _.0 _.1 _.2)\n (absento (closure _.3) (closure _.4)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list 'quote _.3)) _.0)))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list 'quote _.3)) _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.3 closure)) ((_.3 list))\n ((_.3 quote)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list _.3 _.0)) 'quote)))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list _.3 _.0)) 'quote))))\n (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure))\n ((_.3 list)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list 'quote ((lambda (_.3) _.3) _.0))))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list 'quote ((lambda (_.3) _.3) _.0)))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.3 closure)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) (list))))\n '(lambda (_.0)\n (list _.0 ((lambda (_.1) (list 'quote _.0)) (list)))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list\n _.0\n (list\n ((lambda (_.1) 'quote) '_.2)\n ((lambda (_.3) _.3) _.0))))\n '(lambda (_.0)\n (list\n _.0\n (list\n ((lambda (_.1) 'quote) '_.2)\n ((lambda (_.3) _.3) _.0)))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)) ((_.3 closure)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) (list)))\n '(lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) (list))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list ((lambda (_.1) _.0) _.0) (list 'quote _.0)))\n '(lambda (_.0)\n (list ((lambda (_.1) _.0) _.0) (list 'quote _.0))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list\n (list 'lambda '(_.0) _.0)\n (list ((lambda (_.1) _.1) 'quote) _.0)))\n '(list\n (list 'lambda '(_.0) _.0)\n (list ((lambda (_.1) _.1) 'quote) _.0)))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1))\n (((lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) _.0))\n '(lambda (_.0)\n ((lambda (_.1) (list _.0 (list 'quote _.0))) _.0)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1))\n (((lambda (_.0)\n (list\n (list 'lambda '(_.0) _.0)\n ((lambda (_.1) (list 'quote _.0)) '_.2)))\n '(list\n (list 'lambda '(_.0) _.0)\n ((lambda (_.1) (list 'quote _.0)) '_.2)))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 list)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list 'quote ((lambda (_.3) _.0) _.0))))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n (list 'quote ((lambda (_.3) _.0) _.0)))))\n (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list 'quote _.0)) _.0)))\n '(lambda (_.0)\n (list\n ((lambda (_.1) _.0) '_.2)\n ((lambda (_.3) (list 'quote _.0)) _.0))))\n (=/= ((_.0 _.1)) ((_.0 _.3)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.3 closure))\n ((_.3 list)) ((_.3 quote)))\n (sym _.0 _.1 _.3)\n (absento (closure _.2)))\n (((lambda (_.0)\n ((lambda (_.1)\n (list ((lambda (_.2) _.0) '_.3) (list _.1 _.0)))\n 'quote))\n '(lambda (_.0)\n ((lambda (_.1)\n (list ((lambda (_.2) _.0) '_.3) (list _.1 _.0)))\n 'quote)))\n (=/= ((_.0 _.1)) ((_.0 _.2)) ((_.0 closure)) ((_.0 lambda))\n ((_.0 list)) ((_.0 quote)) ((_.1 closure)) ((_.1 lambda))\n ((_.1 list)) ((_.1 quote)) ((_.2 closure)))\n (sym _.0 _.1 _.2)\n (absento (closure _.3)))))\n\n(test \"2 twines\"\n (run 2 (x) (fresh (p q)\n\t (=/= p q)\n\t (eval-expo p '() q)\n\t (eval-expo q '() p)\n\t (== `(,p ,q) x)))\n '((('((lambda (_.0)\n (list 'quote (list _.0 (list 'quote _.0))))\n '(lambda (_.0) (list 'quote (list _.0 (list 'quote _.0)))))\n ((lambda (_.0) (list 'quote (list _.0 (list 'quote _.0))))\n '(lambda (_.0) (list 'quote (list _.0 (list 'quote _.0))))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n (('((lambda (_.0)\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n '(lambda (_.0)\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))\n ((lambda (_.0)\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))\n '(lambda (_.0)\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))))\n\n(test \"4 thrines\"\n (run 4 (x)\n (fresh (p q r)\n (=/= p q)\n (=/= q r)\n (=/= r p)\n (eval-expo p '() q)\n (eval-expo q '() r)\n (eval-expo r '() p)\n (== `(,p ,q ,r) x)))\n '(((''((lambda (_.0)\n (list 'quote (list 'quote (list _.0 (list 'quote _.0)))))\n '(lambda (_.0)\n (list 'quote (list 'quote (list _.0 (list 'quote _.0))))))\n '((lambda (_.0)\n (list 'quote (list 'quote (list _.0 (list 'quote _.0)))))\n '(lambda (_.0)\n (list 'quote (list 'quote (list _.0 (list 'quote _.0))))))\n ((lambda (_.0)\n (list 'quote (list 'quote (list _.0 (list 'quote _.0)))))\n '(lambda (_.0)\n (list 'quote (list 'quote (list _.0 (list 'quote _.0)))))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n ((''((lambda (_.0)\n (list\n 'quote\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))\n '(lambda (_.0)\n (list\n 'quote\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))))\n '((lambda (_.0)\n (list\n 'quote\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))\n '(lambda (_.0)\n (list\n 'quote\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0))))))\n ((lambda (_.0)\n (list\n 'quote\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))\n '(lambda (_.0)\n (list\n 'quote\n (list\n 'quote\n (list ((lambda (_.1) _.0) '_.2) (list 'quote _.0)))))))\n (=/= ((_.0 _.1)) ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)))\n (sym _.0 _.1)\n (absento (closure _.2)))\n (('(list\n '(lambda (_.0)\n (list\n 'quote\n (list 'list _.0 (list 'quote (list 'quote _.0)))))\n '''(lambda (_.0)\n (list\n 'quote\n (list 'list _.0 (list 'quote (list 'quote _.0))))))\n (list\n '(lambda (_.0)\n (list\n 'quote\n (list 'list _.0 (list 'quote (list 'quote _.0)))))\n '''(lambda (_.0)\n (list\n 'quote\n (list 'list _.0 (list 'quote (list 'quote _.0))))))\n ((lambda (_.0)\n (list\n 'quote\n (list 'list _.0 (list 'quote (list 'quote _.0)))))\n ''(lambda (_.0)\n (list\n 'quote\n (list 'list _.0 (list 'quote (list 'quote _.0)))))))\n (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote)))\n (sym _.0))\n ((''((lambda (_.0)\n (list\n ((lambda (_.1) 'quote) '_.2)\n (list 'quote (list _.0 (list 'quote _.0)))))\n '(lambda (_.0)\n (list\n ((lambda (_.1) 'quote) '_.2)\n (list 'quote (list _.0 (list 'quote _.0))))))\n '((lambda (_.0)\n (list\n ((lambda (_.1) 'quote) '_.2)\n (list 'quote (list _.0 (list 'quote _.0)))))\n '(lambda (_.0)\n (list\n ((lambda (_.1) 'quote) '_.2)\n (list 'quote (list _.0 (list 'quote _.0))))))\n ((lambda (_.0)\n (list\n ((lambda (_.1) 'quote) '_.2)\n (list 'quote (list _.0 (list 'quote _.0)))))\n '(lambda (_.0)\n (list\n ((lambda (_.1) 'quote) '_.2)\n (list 'quote (list _.0 (list 'quote _.0)))))))\n (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list))\n ((_.0 quote)) ((_.1 closure)) ((_.1 quote)))\n (sym _.0 _.1)\n (absento (closure _.2)))))\n" } ]