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)))))