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