├── .gitmodules ├── LICENSE ├── README.md ├── interp-match.scm ├── interp-uber-tests.scm ├── interp-uber.scm ├── interp-with-variadic-lambda-and-map-and-match.scm ├── interp-with-variadic-lambda-and-match.scm ├── interp-with-variadic-lambda-and-or-and-match.scm ├── match-tests.scm ├── variadic-lambda-tests.scm ├── variadic-lambda-with-map-tests.scm └── variadic-lambda-with-or-tests.scm /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "mk"] 2 | path = mk 3 | url = https://github.com/webyrd/miniKanren-with-symbolic-constraints 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | The MIT License (MIT) 2 | 3 | Copyright (c) 2015 William E. Byrd 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # relational-interp-with-match 2 | Relational Scheme interpreter, written in miniKanren, with a pattern-matcher supporting a subset of Racket's `match` syntax. 3 | 4 | Joint work with Michael Ballantyne 5 | 6 | 7 | Grammar for `match`: 8 | 9 | ``` 10 | (match ,expr ,clause ,clauses ...) 11 | 12 | clause ::= (,toppattern ,expr) 13 | 14 | toppattern ::= selfevalliteral | pattern | (quasiquote ,quasipattern) 15 | 16 | pattern ::= var | (? ,pred ,var) 17 | 18 | quasipattern ::= literal | (,quasipattern . ,quasipattern) | (unquote ,pattern) 19 | 20 | selfevalliteral ::= number | #t | #f 21 | 22 | literal ::= selfevalliteral | symbol | () 23 | 24 | var ::= 25 | 26 | pred ::= symbol? | number? 27 | ``` 28 | 29 | 30 | TODO: 31 | 32 | * Add support for `letrec` and multiple argument `lambda` and application. `letrec` support will probably require moving to a tagged environment. 33 | * Try adding another argument to `match-pattern` so we can accumulate the environment rather than calling `appendo` afterwards. This may give better performance, and is probably necessary for handling tagged environments, as in `letrec`. 34 | * Try writing a simple theorem prover, etc., using `match`. 35 | * Figure out whether it is necessary to add `(absento 'closure pattern)` or the equivalent. I don't think so, but I'm not certain. 36 | * Figure out why `run*` for test `match-8-backwards` takes so long, even though run 2 is fast. Is there a way to speed this up? 37 | -------------------------------------------------------------------------------- /interp-match.scm: -------------------------------------------------------------------------------- 1 | (load "mk/mk.scm") 2 | 3 | ;; match grammar 4 | ;; 5 | ;; 6 | ;; (match ,expr ,clause ,clauses ...) 7 | ;; 8 | ;; clause ::= (,toppattern ,expr) 9 | ;; 10 | ;; toppattern ::= selfevalliteral | pattern | (quasiquote ,quasipattern) 11 | ;; 12 | ;; pattern ::= var | (? ,pred ,var) 13 | ;; 14 | ;; quasipattern ::= literal | (,quasipattern . ,quasipattern) | (unquote ,pattern) 15 | ;; 16 | ;; selfevalliteral ::= number | #t | #f 17 | ;; 18 | ;; literal ::= selfevalliteral | symbol | () 19 | ;; 20 | ;; var ::= 21 | ;; 22 | ;; pred ::= symbol? | number? 23 | 24 | 25 | 26 | ;; really should be a constraint built into miniKanren 27 | (define not-symbolo 28 | (lambda (t) 29 | (conde 30 | [(== #f t)] 31 | [(== #t t)] 32 | [(numbero t)] 33 | [(fresh (a d) 34 | (== `(,a . ,d) t))]))) 35 | 36 | (define not-numbero 37 | (lambda (t) 38 | (conde 39 | [(== #f t)] 40 | [(== #t t)] 41 | [(symbolo t)] 42 | [(fresh (a d) 43 | (== `(,a . ,d) t))]))) 44 | 45 | (define self-eval-literalo 46 | (lambda (t) 47 | (conde 48 | [(numbero t)] 49 | [(booleano t)]))) 50 | 51 | (define literalo 52 | (lambda (t) 53 | (conde 54 | [(numbero t)] 55 | [(symbolo t)] 56 | [(booleano t)] 57 | [(== '() t)]))) 58 | 59 | (define booleano 60 | (lambda (t) 61 | (conde 62 | [(== #f t)] 63 | [(== #t t)]))) 64 | 65 | (define (appendo l s out) 66 | (conde 67 | [(== '() l) (== s out)] 68 | [(fresh (a d res) 69 | (== `(,a . ,d) l) 70 | (== `(,a . ,res) out) 71 | (appendo d s res))])) 72 | 73 | (define (lookupo x env val) 74 | (fresh (y v env^) 75 | (== `((,y . ,v) . ,env^) env) 76 | (conde 77 | [(== x y) (== v val)] 78 | [(=/= x y) (lookupo x env^ val)]))) 79 | 80 | (define (not-in-envo x env) 81 | (conde 82 | [(== '() env)] 83 | [(fresh (y v env^) 84 | (== `((,y . ,v) . ,env^) env) 85 | (=/= x y) 86 | (not-in-envo x env^))])) 87 | 88 | (define (eval-expo expr env val) 89 | (conde 90 | [(numbero expr) 91 | (== expr val)] 92 | [(booleano expr) 93 | (== expr val)] 94 | [(== `(quote ,val) expr) 95 | (absento 'closure val) 96 | (not-in-envo 'quote env)] 97 | [(symbolo expr) 98 | (lookupo expr env val)] 99 | [(fresh (x body) 100 | (== `(lambda (,x) ,body) expr) 101 | (== `(closure ,x ,body ,env) val) 102 | (symbolo x) 103 | (not-in-envo 'lambda env))] 104 | [(fresh (e1 e2 v1 v2) 105 | (== `(cons ,e1 ,e2) expr) 106 | (== `(,v1 . ,v2) val) 107 | (not-in-envo 'cons env) 108 | (eval-expo e1 env v1) 109 | (eval-expo e2 env v2))] 110 | [(fresh (rator rand x body env^ arg) 111 | (== `(,rator ,rand) expr) 112 | (symbolo x) 113 | (eval-expo rator env `(closure ,x ,body ,env^)) 114 | (eval-expo rand env arg) 115 | (eval-expo body `((,x . ,arg) . ,env^) val))] 116 | [(fresh (against-expr against-val clause clauses) 117 | (== `(match ,against-expr ,clause . ,clauses) expr) 118 | (not-in-envo 'match env) 119 | (eval-expo against-expr env against-val) 120 | (match-clauses against-val `(,clause . ,clauses) env val))])) 121 | 122 | (define (match-clauses against-val clauses env val) 123 | (fresh (top-pattern result-expr d penv) 124 | (== `((,top-pattern ,result-expr) . ,d) clauses) 125 | (conde 126 | [(fresh (env^) 127 | (top-pattern-matches top-pattern against-val '() penv) 128 | (appendo penv env env^) 129 | (eval-expo result-expr env^ val))] 130 | [(top-pattern-but-doesnt-match top-pattern against-val '() penv) 131 | (match-clauses against-val d env val)]))) 132 | 133 | 134 | 135 | (define (top-pattern-matches top-pattern against-val penv penv-out) 136 | (conde 137 | [(self-eval-literalo top-pattern) (== top-pattern against-val) (== penv penv-out)] 138 | [(pattern-matches top-pattern against-val penv penv-out)] 139 | [(fresh (quasi-pattern) 140 | (== (list 'quasiquote quasi-pattern) top-pattern) 141 | (quasi-pattern-matches quasi-pattern against-val penv penv-out))])) 142 | 143 | (define (top-pattern-but-doesnt-match top-pattern against-val penv penv-out) 144 | (conde 145 | [(self-eval-literalo top-pattern) (=/= top-pattern against-val) (== penv penv-out)] 146 | [(pattern-but-doesnt-match top-pattern against-val penv penv-out)] 147 | [(fresh (quasi-pattern) 148 | (== (list 'quasiquote quasi-pattern) top-pattern) 149 | (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out))])) 150 | 151 | 152 | (define (var-pattern-matches var against-val penv penv-out) 153 | (fresh (val) 154 | (symbolo var) 155 | (conde 156 | [(== against-val val) 157 | (== penv penv-out) 158 | (lookupo var penv val)] 159 | [(== `((,var . ,against-val) . ,penv) penv-out) 160 | (not-in-envo var penv)]))) 161 | 162 | (define (var-pattern-but-doesnt-match var against-val penv penv-out) 163 | (fresh (val) 164 | (symbolo var) 165 | (=/= against-val val) 166 | (== penv penv-out) 167 | (lookupo var penv val))) 168 | 169 | 170 | 171 | (define (pattern-matches pattern against-val penv penv-out) 172 | (conde 173 | [(var-pattern-matches pattern against-val penv penv-out)] 174 | [(fresh (var pred val) 175 | (== `(? ,pred ,var) pattern) 176 | (conde 177 | [(== 'symbol? pred) 178 | (symbolo against-val)] 179 | [(== 'number? pred) 180 | (numbero against-val)]) 181 | (var-pattern-matches var against-val penv penv-out))])) 182 | 183 | (define (pattern-but-doesnt-match pattern against-val penv penv-out) 184 | (conde 185 | [(var-pattern-but-doesnt-match pattern against-val penv penv-out)] 186 | [(fresh (var pred val) 187 | (== `(? ,pred ,var) pattern) 188 | (== penv penv-out) 189 | (symbolo var) 190 | (conde 191 | [(== 'symbol? pred) 192 | (conde 193 | [(not-symbolo against-val)] 194 | [(symbolo against-val) 195 | (var-pattern-but-doesnt-match var against-val penv penv-out)])] 196 | [(== 'number? pred) 197 | (conde 198 | [(not-numbero against-val)] 199 | [(numbero against-val) 200 | (var-pattern-but-doesnt-match var against-val penv penv-out)])]))])) 201 | 202 | 203 | 204 | (define (quasi-pattern-matches quasi-pattern against-val penv penv-out) 205 | (conde 206 | [(== quasi-pattern against-val) 207 | (== penv penv-out) 208 | (literalo quasi-pattern)] 209 | [(fresh (pattern) 210 | (== (list 'unquote pattern) quasi-pattern) 211 | (pattern-matches pattern against-val penv penv-out))] 212 | [(fresh (a d v1 v2 penv^) 213 | (== `(,a . ,d) quasi-pattern) 214 | (== `(,v1 . ,v2) against-val) 215 | (=/= 'unquote a) 216 | (quasi-pattern-matches a v1 penv penv^) 217 | (quasi-pattern-matches d v2 penv^ penv-out))])) 218 | 219 | (define (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out) 220 | (conde 221 | [(=/= quasi-pattern against-val) 222 | (== penv penv-out) 223 | (literalo quasi-pattern)] 224 | [(fresh (pattern) 225 | (== (list 'unquote pattern) quasi-pattern) 226 | (pattern-but-doesnt-match pattern against-val penv penv-out))] 227 | [(fresh (a d) 228 | (== `(,a . ,d) quasi-pattern) 229 | (=/= 'unquote a) 230 | (conde 231 | [(== penv penv-out) 232 | (literalo against-val)] 233 | [(fresh (v1 v2 penv^) 234 | (== `(,v1 . ,v2) against-val) 235 | (conde 236 | [(quasi-pattern-but-doesnt-match a v1 penv penv^)] 237 | [(quasi-pattern-matches a v1 penv penv^) 238 | (quasi-pattern-but-doesnt-match d v2 penv^ penv-out)]))]))])) 239 | -------------------------------------------------------------------------------- /interp-uber-tests.scm: -------------------------------------------------------------------------------- 1 | (load "interp-uber.scm") 2 | (load "mk/test-check.scm") 3 | (load "mk/matche.scm") 4 | 5 | ;; We use the relational Racket interpreter, extended to support 'and' 6 | ;; and 'or', to allow us to write a simple proof checker for 7 | ;; propositional logic as a Racket function. Because we can treat the 8 | ;; Racket function as a relation, this proof *checker* can act as a 9 | ;; theorem prover, finding a proof tree to prove a theorem. 10 | 11 | ;; The simple proof checker and proof example are from Matt Might. 12 | 13 | 14 | 15 | ;; The proof checker uses 'and', so we have added both 'and' and 'or' 16 | ;; to the relational interpreter. We can't just add 'and' as a helper 17 | ;; function, as we do with 'member?', since 'and' uses short-circuit 18 | ;; evaluation. 19 | 20 | ;; Let's test 'and' and 'or': 21 | 22 | ;; and tests 23 | (test "and-0" 24 | (run* (q) (eval-expo '(and) '() q)) 25 | '(#t)) 26 | 27 | (test "and-1" 28 | (run* (q) (eval-expo '(and 5) '() q)) 29 | '(5)) 30 | 31 | (test "and-2" 32 | (run* (q) (eval-expo '(and #f) '() q)) 33 | '(#f)) 34 | 35 | (test "and-3" 36 | (run* (q) (eval-expo '(and 5 6) '() q)) 37 | '(6)) 38 | 39 | (test "and-4" 40 | (run* (q) (eval-expo '(and #f 6) '() q)) 41 | '(#f)) 42 | 43 | (test "and-5" 44 | (run* (q) (eval-expo '(and (null? '()) 6) '() q)) 45 | '(6)) 46 | 47 | (test "and-6" 48 | (run* (q) (eval-expo '(and (null? '(a b c)) 6) '() q)) 49 | '(#f)) 50 | 51 | 52 | ;; or tests 53 | (test "or-0" 54 | (run* (q) (eval-expo '(or) '() q)) 55 | '(#f)) 56 | 57 | (test "or-1" 58 | (run* (q) (eval-expo '(or 5) '() q)) 59 | '(5)) 60 | 61 | (test "or-2" 62 | (run* (q) (eval-expo '(or #f) '() q)) 63 | '(#f)) 64 | 65 | (test "or-3" 66 | (run* (q) (eval-expo '(or 5 6) '() q)) 67 | '(5)) 68 | 69 | (test "or-4" 70 | (run* (q) (eval-expo '(or #f 6) '() q)) 71 | '(6)) 72 | 73 | (test "or-5" 74 | (run* (q) (eval-expo '(or (null? '()) 6) '() q)) 75 | '(#t)) 76 | 77 | (test "or-6" 78 | (run* (q) (eval-expo '(or (null? '(a b c)) 6) '() q)) 79 | '(6)) 80 | 81 | 82 | ;; We now port Matt Might's proof checker to use the subset of Racket 83 | ;; supported by our relational interpreter. Our example problem is 84 | ;; also from Matt. 85 | ;; 86 | ;; Matt's minimalist proof checker for propositional logic: 87 | 88 | #| 89 | (define (proof? proof) 90 | (match proof 91 | ((assumption ,assms () ,A) (member? A assms)) 92 | ((modus-ponens 93 | ,assms (,(and ant1 ‘(,_ ,assms1 ,_ (if ,A ,B))) 94 | ,(and ant2 ‘(,_ ,assms2 ,_ ,C))) ,D) 95 | (and (equal? A C) (equal? B D) 96 | (equal? assms assms1) (equal? assms assms2) 97 | (proof? ant1) 98 | (proof? ant2))))) 99 | |# 100 | 101 | ;; Here is our port of the proof checker to our interpreter. We use 102 | ;; 'letrec' instead of 'define', we define 'member?' as a helper 103 | ;; function, and use Racket's pattern-matching syntax. The resulting 104 | ;; 'letrec' expression runs without modification in Racket, since the 105 | ;; expression does not include any logic variables. 106 | 107 | ;; We are asking the proof checker to check our proof of C, using the 108 | ;; assumptions A, A => B, and B => C. Note that we give the entire 109 | ;; proof tree as the input to 'proof?'. 110 | 111 | ;; 4 collections 112 | ;; 3980 ms elapsed cpu time, including 0 ms collecting 113 | ;; 3985 ms elapsed real time, including 0 ms collecting 114 | ;; 33762080 bytes allocated 115 | (test "proof-1" 116 | (run* (q) 117 | (eval-expo 118 | `(letrec ((member? (lambda (x ls) 119 | (if (null? ls) 120 | #f 121 | (if (equal? (car ls) x) 122 | #t 123 | (member? x (cdr ls))))))) 124 | (letrec ((proof? (lambda (proof) 125 | (match proof 126 | [`(assumption ,assms () ,A) 127 | (member? A assms)] 128 | [`(modus-ponens 129 | ,assms 130 | ((,r1 ,assms ,ants1 (if ,A ,B)) 131 | (,r2 ,assms ,ants2 ,A)) 132 | ,B) 133 | (and (proof? (list r1 assms ants1 (list 'if A B))) 134 | (proof? (list r2 assms ants2 A)))])))) 135 | (proof? '(modus-ponens 136 | (A (if A B) (if B C)) 137 | ((assumption (A (if A B) (if B C)) () (if B C)) 138 | (modus-ponens 139 | (A (if A B) (if B C)) 140 | ((assumption (A (if A B) (if B C)) () (if A B)) 141 | (assumption (A (if A B) (if B C)) () A)) B)) 142 | C)))) 143 | '() 144 | q)) 145 | '(#t)) 146 | 147 | ;; Getting ready to run the proof checker as a theorem prover. To 148 | ;; make sure our query has the right syntactic structure, we unify 149 | ;; 'prf' with the answer. So we are still running the proof checker 150 | ;; "forwards," although we are using logic variables, so this code 151 | ;; doesn't run directly in Racket. 152 | 153 | ;; 3 collections 154 | ;; 3478 ms elapsed cpu time, including 0 ms collecting 155 | ;; 3480 ms elapsed real time, including 0 ms collecting 156 | ;; 23896992 bytes allocated 157 | (test "proof-2a" 158 | (run* (prf) 159 | (fresh (rule assms ants) 160 | (== '(modus-ponens 161 | (A (if A B) (if B C)) 162 | ((assumption (A (if A B) (if B C)) () (if B C)) 163 | (modus-ponens 164 | (A (if A B) (if B C)) 165 | ((assumption (A (if A B) (if B C)) () (if A B)) 166 | (assumption (A (if A B) (if B C)) () A)) B)) 167 | C) 168 | prf) 169 | (eval-expo 170 | `(letrec ((member? (lambda (x ls) 171 | (if (null? ls) 172 | #f 173 | (if (equal? (car ls) x) 174 | #t 175 | (member? x (cdr ls))))))) 176 | (letrec ((proof? (lambda (proof) 177 | (match proof 178 | [`(assumption ,assms () ,A) 179 | (member? A assms)] 180 | [`(modus-ponens 181 | ,assms 182 | ((,r1 ,assms ,ants1 (if ,A ,B)) 183 | (,r2 ,assms ,ants2 ,A)) 184 | ,B) 185 | (and (proof? (list r1 assms ants1 (list 'if A B))) 186 | (proof? (list r2 assms ants2 A)))])))) 187 | (proof? ',prf))) 188 | '() 189 | #t))) 190 | '((modus-ponens (A (if A B) (if B C)) 191 | ((assumption (A (if A B) (if B C)) () (if B C)) 192 | (modus-ponens (A (if A B) (if B C)) 193 | ((assumption (A (if A B) (if B C)) () (if A B)) 194 | (assumption (A (if A B) (if B C)) () A)) 195 | B)) 196 | C))) 197 | 198 | ;; Another test to ensure we are instantiating 'prf' and 'assms' to 199 | ;; the correct terms before we try running the proof checker as a 200 | ;; theorem prover. Once again, this test runs forwards. 201 | 202 | ;; 3 collections 203 | ;; 3352 ms elapsed cpu time, including 0 ms collecting 204 | ;; 3356 ms elapsed real time, including 0 ms collecting 205 | ;; 23833552 bytes allocated 206 | (test "proof-2b" 207 | (run* (prf) 208 | (fresh (rule assms ants) 209 | (== `(,rule ,assms ,ants C) prf) 210 | (== `(A (if A B) (if B C)) assms) 211 | (== '(modus-ponens 212 | (A (if A B) (if B C)) 213 | ((assumption (A (if A B) (if B C)) () (if B C)) 214 | (modus-ponens 215 | (A (if A B) (if B C)) 216 | ((assumption (A (if A B) (if B C)) () (if A B)) 217 | (assumption (A (if A B) (if B C)) () A)) B)) 218 | C) 219 | prf) 220 | (eval-expo 221 | `(letrec ((member? (lambda (x ls) 222 | (if (null? ls) 223 | #f 224 | (if (equal? (car ls) x) 225 | #t 226 | (member? x (cdr ls))))))) 227 | (letrec ((proof? (lambda (proof) 228 | (match proof 229 | [`(assumption ,assms () ,A) 230 | (member? A assms)] 231 | [`(modus-ponens 232 | ,assms 233 | ((,r1 ,assms ,ants1 (if ,A ,B)) 234 | (,r2 ,assms ,ants2 ,A)) 235 | ,B) 236 | (and (proof? (list r1 assms ants1 (list 'if A B))) 237 | (proof? (list r2 assms ants2 A)))])))) 238 | (proof? ',prf))) 239 | '() 240 | #t))) 241 | '((modus-ponens (A (if A B) (if B C)) 242 | ((assumption (A (if A B) (if B C)) () (if B C)) 243 | (modus-ponens (A (if A B) (if B C)) 244 | ((assumption (A (if A B) (if B C)) () (if A B)) 245 | (assumption (A (if A B) (if B C)) () A)) 246 | B)) 247 | C))) 248 | 249 | ;; The real test! We are no longer unifying 'prf' with the answer. 250 | ;; The proof checker is now inferring the proof tree for the theorem 251 | ;; we are trying to prove (C) given a set of assumptions (A, A => B, 252 | ;; and B => C). The proof checker *function* is now acting as a 253 | ;; *relation*, which lets us use it as a theorem prover. 254 | 255 | ;; 10 collections 256 | ;; 12273 ms elapsed cpu time, including 1 ms collecting 257 | ;; 12283 ms elapsed real time, including 2 ms collecting 258 | ;; 82533568 bytes allocated 259 | ;; 260 | ;; run 2 seems to diverge 261 | (test "proof-2c" 262 | (run 1 (prf) 263 | (fresh (rule assms ants) 264 | ;; We want to prove that C holds... 265 | (== `(,rule ,assms ,ants C) prf) 266 | ;; ...given the assumptions A, A => B, and B => C. 267 | (== `(A (if A B) (if B C)) assms) 268 | (eval-expo 269 | `(letrec ((member? (lambda (x ls) 270 | (if (null? ls) 271 | #f 272 | (if (equal? (car ls) x) 273 | #t 274 | (member? x (cdr ls))))))) 275 | (letrec ((proof? (lambda (proof) 276 | (match proof 277 | [`(assumption ,assms () ,A) 278 | (member? A assms)] 279 | [`(modus-ponens 280 | ,assms 281 | ((,r1 ,assms ,ants1 (if ,A ,B)) 282 | (,r2 ,assms ,ants2 ,A)) 283 | ,B) 284 | (and (proof? (list r1 assms ants1 (list 'if A B))) 285 | (proof? (list r2 assms ants2 A)))])))) 286 | (proof? ',prf))) 287 | '() 288 | #t))) 289 | '((modus-ponens (A (if A B) (if B C)) 290 | ((assumption (A (if A B) (if B C)) () (if B C)) 291 | (modus-ponens (A (if A B) (if B C)) 292 | ((assumption (A (if A B) (if B C)) () (if A B)) 293 | (assumption (A (if A B) (if B C)) () A)) 294 | B)) 295 | C))) 296 | 297 | ;; Here we run the proof checker/theorem prover with a fresh logic variable 298 | ;; representing the proof tree. This allows us to generate valid 299 | ;; proof trees, where each proof tree contains a theorem and the 300 | ;; assumptions used to prove that theorem. 301 | ;; 302 | ;; From the answers it is clear the prover tends to generate "proofs 303 | ;; by assumption", assuming the theorem to be proved. This isn't 304 | ;; surprising, since such proofs require relatively little 305 | ;; computation. A couple of the proof trees do use modus ponens, 306 | ;; however. 307 | ;; 308 | ;; 18 collections 309 | ;; 45118 ms elapsed cpu time, including 3 ms collecting 310 | ;; 45137 ms elapsed real time, including 4 ms collecting 311 | ;; 150564400 bytes allocated 312 | (test "generate-theorems/proofs" 313 | (run 20 (prf) 314 | (eval-expo 315 | `(letrec ((member? (lambda (x ls) 316 | (if (null? ls) 317 | #f 318 | (if (equal? (car ls) x) 319 | #t 320 | (member? x (cdr ls))))))) 321 | (letrec ((proof? (lambda (proof) 322 | (match proof 323 | [`(assumption ,assms () ,A) 324 | (member? A assms)] 325 | [`(modus-ponens 326 | ,assms 327 | ((,r1 ,assms ,ants1 (if ,A ,B)) 328 | (,r2 ,assms ,ants2 ,A)) 329 | ,B) 330 | (and (proof? (list r1 assms ants1 (list 'if A B))) 331 | (proof? (list r2 assms ants2 A)))])))) 332 | (proof? ',prf))) 333 | '() 334 | #t)) 335 | '(((assumption (_.0 . _.1) () _.0) 336 | (absento (closure _.0) (closure _.1))) 337 | ((assumption (_.0 _.1 . _.2) () _.1) (=/= ((_.0 _.1))) 338 | (absento (closure _.0) (closure _.1) (closure _.2))) 339 | ((assumption (_.0 _.1 _.2 . _.3) () _.2) 340 | (=/= ((_.0 _.2)) ((_.1 _.2))) 341 | (absento (closure _.0) (closure _.1) (closure _.2) (closure _.3))) 342 | ((assumption (_.0 _.1 _.2 _.3 . _.4) () _.3) 343 | (=/= ((_.0 _.3)) ((_.1 _.3)) ((_.2 _.3))) 344 | (absento (closure _.0) (closure _.1) (closure _.2) 345 | (closure _.3) (closure _.4))) 346 | ((assumption (_.0 _.1 _.2 _.3 _.4 . _.5) () _.4) 347 | (=/= ((_.0 _.4)) ((_.1 _.4)) ((_.2 _.4)) ((_.3 _.4))) 348 | (absento (closure _.0) (closure _.1) (closure _.2) 349 | (closure _.3) (closure _.4) (closure _.5))) 350 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 . _.6) () _.5) 351 | (=/= ((_.0 _.5)) ((_.1 _.5)) ((_.2 _.5)) ((_.3 _.5)) 352 | ((_.4 _.5))) 353 | (absento (closure _.0) (closure _.1) (closure _.2) 354 | (closure _.3) (closure _.4) (closure _.5) 355 | (closure _.6))) 356 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 . _.7) () _.6) 357 | (=/= ((_.0 _.6)) ((_.1 _.6)) ((_.2 _.6)) ((_.3 _.6)) 358 | ((_.4 _.6)) ((_.5 _.6))) 359 | (absento (closure _.0) (closure _.1) (closure _.2) 360 | (closure _.3) (closure _.4) (closure _.5) 361 | (closure _.6) (closure _.7))) 362 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 . _.8) () _.7) 363 | (=/= ((_.0 _.7)) ((_.1 _.7)) ((_.2 _.7)) ((_.3 _.7)) 364 | ((_.4 _.7)) ((_.5 _.7)) ((_.6 _.7))) 365 | (absento (closure _.0) (closure _.1) (closure _.2) 366 | (closure _.3) (closure _.4) (closure _.5) 367 | (closure _.6) (closure _.7) (closure _.8))) 368 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 . _.9) () _.8) 369 | (=/= ((_.0 _.8)) ((_.1 _.8)) ((_.2 _.8)) ((_.3 _.8)) 370 | ((_.4 _.8)) ((_.5 _.8)) ((_.6 _.8)) ((_.7 _.8))) 371 | (absento (closure _.0) (closure _.1) (closure _.2) 372 | (closure _.3) (closure _.4) (closure _.5) 373 | (closure _.6) (closure _.7) (closure _.8) 374 | (closure _.9))) 375 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 . _.10) () _.9) 376 | (=/= ((_.0 _.9)) ((_.1 _.9)) ((_.2 _.9)) ((_.3 _.9)) 377 | ((_.4 _.9)) ((_.5 _.9)) ((_.6 _.9)) ((_.7 _.9)) 378 | ((_.8 _.9))) 379 | (absento (closure _.0) (closure _.1) (closure _.10) 380 | (closure _.2) (closure _.3) (closure _.4) 381 | (closure _.5) (closure _.6) (closure _.7) 382 | (closure _.8) (closure _.9))) 383 | ((assumption 384 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 . _.11) 385 | () _.10) 386 | (=/= ((_.0 _.10)) ((_.1 _.10)) ((_.10 _.2)) ((_.10 _.3)) 387 | ((_.10 _.4)) ((_.10 _.5)) ((_.10 _.6)) ((_.10 _.7)) 388 | ((_.10 _.8)) ((_.10 _.9))) 389 | (absento (closure _.0) (closure _.1) (closure _.10) 390 | (closure _.11) (closure _.2) (closure _.3) 391 | (closure _.4) (closure _.5) (closure _.6) 392 | (closure _.7) (closure _.8) (closure _.9))) 393 | ((assumption 394 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 . _.12) 395 | () _.11) 396 | (=/= ((_.0 _.11)) ((_.1 _.11)) ((_.10 _.11)) 397 | ((_.11 _.2)) ((_.11 _.3)) ((_.11 _.4)) ((_.11 _.5)) 398 | ((_.11 _.6)) ((_.11 _.7)) ((_.11 _.8)) ((_.11 _.9))) 399 | (absento (closure _.0) (closure _.1) (closure _.10) 400 | (closure _.11) (closure _.12) (closure _.2) 401 | (closure _.3) (closure _.4) (closure _.5) 402 | (closure _.6) (closure _.7) (closure _.8) 403 | (closure _.9))) 404 | ((assumption 405 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 . _.13) 406 | () _.12) 407 | (=/= ((_.0 _.12)) ((_.1 _.12)) ((_.10 _.12)) 408 | ((_.11 _.12)) ((_.12 _.2)) ((_.12 _.3)) ((_.12 _.4)) 409 | ((_.12 _.5)) ((_.12 _.6)) ((_.12 _.7)) ((_.12 _.8)) 410 | ((_.12 _.9))) 411 | (absento (closure _.0) (closure _.1) (closure _.10) 412 | (closure _.11) (closure _.12) (closure _.13) 413 | (closure _.2) (closure _.3) (closure _.4) 414 | (closure _.5) (closure _.6) (closure _.7) 415 | (closure _.8) (closure _.9))) 416 | ((assumption 417 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 _.13 . _.14) 418 | () _.13) 419 | (=/= ((_.0 _.13)) ((_.1 _.13)) ((_.10 _.13)) 420 | ((_.11 _.13)) ((_.12 _.13)) ((_.13 _.2)) ((_.13 _.3)) 421 | ((_.13 _.4)) ((_.13 _.5)) ((_.13 _.6)) ((_.13 _.7)) 422 | ((_.13 _.8)) ((_.13 _.9))) 423 | (absento (closure _.0) (closure _.1) (closure _.10) 424 | (closure _.11) (closure _.12) (closure _.13) 425 | (closure _.14) (closure _.2) (closure _.3) 426 | (closure _.4) (closure _.5) (closure _.6) 427 | (closure _.7) (closure _.8) (closure _.9))) 428 | ((modus-ponens ((if _.0 _.1) _.0 . _.2) 429 | ((assumption ((if _.0 _.1) _.0 . _.2) () (if _.0 _.1)) 430 | (assumption ((if _.0 _.1) _.0 . _.2) () _.0)) 431 | _.1) 432 | (absento (closure _.0) (closure _.1) (closure _.2))) 433 | ((assumption 434 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 435 | _.13 _.14 . _.15) 436 | () _.14) 437 | (=/= ((_.0 _.14)) ((_.1 _.14)) ((_.10 _.14)) 438 | ((_.11 _.14)) ((_.12 _.14)) ((_.13 _.14)) ((_.14 _.2)) 439 | ((_.14 _.3)) ((_.14 _.4)) ((_.14 _.5)) ((_.14 _.6)) 440 | ((_.14 _.7)) ((_.14 _.8)) ((_.14 _.9))) 441 | (absento (closure _.0) (closure _.1) (closure _.10) 442 | (closure _.11) (closure _.12) (closure _.13) 443 | (closure _.14) (closure _.15) (closure _.2) 444 | (closure _.3) (closure _.4) (closure _.5) 445 | (closure _.6) (closure _.7) (closure _.8) 446 | (closure _.9))) 447 | ((assumption 448 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 449 | _.13 _.14 _.15 . _.16) 450 | () _.15) 451 | (=/= ((_.0 _.15)) ((_.1 _.15)) ((_.10 _.15)) 452 | ((_.11 _.15)) ((_.12 _.15)) ((_.13 _.15)) 453 | ((_.14 _.15)) ((_.15 _.2)) ((_.15 _.3)) ((_.15 _.4)) 454 | ((_.15 _.5)) ((_.15 _.6)) ((_.15 _.7)) ((_.15 _.8)) 455 | ((_.15 _.9))) 456 | (absento (closure _.0) (closure _.1) (closure _.10) 457 | (closure _.11) (closure _.12) (closure _.13) 458 | (closure _.14) (closure _.15) (closure _.16) 459 | (closure _.2) (closure _.3) (closure _.4) 460 | (closure _.5) (closure _.6) (closure _.7) 461 | (closure _.8) (closure _.9))) 462 | ((assumption 463 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 464 | _.13 _.14 _.15 _.16 . _.17) 465 | () _.16) 466 | (=/= ((_.0 _.16)) ((_.1 _.16)) ((_.10 _.16)) 467 | ((_.11 _.16)) ((_.12 _.16)) ((_.13 _.16)) 468 | ((_.14 _.16)) ((_.15 _.16)) ((_.16 _.2)) ((_.16 _.3)) 469 | ((_.16 _.4)) ((_.16 _.5)) ((_.16 _.6)) ((_.16 _.7)) 470 | ((_.16 _.8)) ((_.16 _.9))) 471 | (absento (closure _.0) (closure _.1) (closure _.10) 472 | (closure _.11) (closure _.12) (closure _.13) 473 | (closure _.14) (closure _.15) (closure _.16) 474 | (closure _.17) (closure _.2) (closure _.3) 475 | (closure _.4) (closure _.5) (closure _.6) 476 | (closure _.7) (closure _.8) (closure _.9))) 477 | ((assumption 478 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 479 | _.13 _.14 _.15 _.16 _.17 . _.18) 480 | () _.17) 481 | (=/= ((_.0 _.17)) ((_.1 _.17)) ((_.10 _.17)) 482 | ((_.11 _.17)) ((_.12 _.17)) ((_.13 _.17)) 483 | ((_.14 _.17)) ((_.15 _.17)) ((_.16 _.17)) ((_.17 _.2)) 484 | ((_.17 _.3)) ((_.17 _.4)) ((_.17 _.5)) ((_.17 _.6)) 485 | ((_.17 _.7)) ((_.17 _.8)) ((_.17 _.9))) 486 | (absento (closure _.0) (closure _.1) (closure _.10) 487 | (closure _.11) (closure _.12) (closure _.13) 488 | (closure _.14) (closure _.15) (closure _.16) 489 | (closure _.17) (closure _.18) (closure _.2) 490 | (closure _.3) (closure _.4) (closure _.5) 491 | (closure _.6) (closure _.7) (closure _.8) 492 | (closure _.9))) 493 | ((modus-ponens ((if _.0 _.1) _.2 _.0 . _.3) 494 | ((assumption ((if _.0 _.1) _.2 _.0 . _.3) () 495 | (if _.0 _.1)) 496 | (assumption ((if _.0 _.1) _.2 _.0 . _.3) () _.0)) 497 | _.1) 498 | (=/= ((_.0 _.2))) 499 | (absento (closure _.0) (closure _.1) (closure _.2) 500 | (closure _.3))))) 501 | 502 | 503 | ;; Since the proof checker/theorem prover tends to generate trivial 504 | ;; proof trees that just assume the theorem to be proved, lets 505 | ;; restrict the outer proof rule to be modus ponens. 506 | ;; 507 | ;; 27 collections 508 | ;; 84672 ms elapsed cpu time, including 7 ms collecting 509 | ;; 84794 ms elapsed real time, including 7 ms collecting 510 | ;; 226336768 bytes allocated 511 | (test "generate-theorems/proofs-using-modus-ponens" 512 | (run 20 (prf) 513 | (fresh (assms ants conseq) 514 | (== `(modus-ponens ,assms ,ants ,conseq) prf) 515 | (eval-expo 516 | `(letrec ((member? (lambda (x ls) 517 | (if (null? ls) 518 | #f 519 | (if (equal? (car ls) x) 520 | #t 521 | (member? x (cdr ls))))))) 522 | (letrec ((proof? (lambda (proof) 523 | (match proof 524 | [`(assumption ,assms () ,A) 525 | (member? A assms)] 526 | [`(modus-ponens 527 | ,assms 528 | ((,r1 ,assms ,ants1 (if ,A ,B)) 529 | (,r2 ,assms ,ants2 ,A)) 530 | ,B) 531 | (and (proof? (list r1 assms ants1 (list 'if A B))) 532 | (proof? (list r2 assms ants2 A)))])))) 533 | (proof? ',prf))) 534 | '() 535 | #t))) 536 | '(((modus-ponens ((if _.0 _.1) _.0 . _.2) 537 | ((assumption ((if _.0 _.1) _.0 . _.2) () (if _.0 _.1)) 538 | (assumption ((if _.0 _.1) _.0 . _.2) () _.0)) 539 | _.1) 540 | (absento (closure _.0) (closure _.1) (closure _.2))) 541 | ((modus-ponens ((if _.0 _.1) _.2 _.0 . _.3) 542 | ((assumption ((if _.0 _.1) _.2 _.0 . _.3) () 543 | (if _.0 _.1)) 544 | (assumption ((if _.0 _.1) _.2 _.0 . _.3) () _.0)) 545 | _.1) 546 | (=/= ((_.0 _.2))) 547 | (absento (closure _.0) (closure _.1) (closure _.2) 548 | (closure _.3))) 549 | ((modus-ponens (_.0 (if _.0 _.1) . _.2) 550 | ((assumption (_.0 (if _.0 _.1) . _.2) () (if _.0 _.1)) 551 | (assumption (_.0 (if _.0 _.1) . _.2) () _.0)) 552 | _.1) 553 | (absento (closure _.0) (closure _.1) (closure _.2))) 554 | ((modus-ponens ((if _.0 _.1) _.2 _.3 _.0 . _.4) 555 | ((assumption ((if _.0 _.1) _.2 _.3 _.0 . _.4) () 556 | (if _.0 _.1)) 557 | (assumption ((if _.0 _.1) _.2 _.3 _.0 . _.4) () _.0)) 558 | _.1) 559 | (=/= ((_.0 _.2)) ((_.0 _.3))) 560 | (absento (closure _.0) (closure _.1) (closure _.2) 561 | (closure _.3) (closure _.4))) 562 | ((modus-ponens ((if _.0 _.1) _.2 _.3 _.4 _.0 . _.5) 563 | ((assumption ((if _.0 _.1) _.2 _.3 _.4 _.0 . _.5) () 564 | (if _.0 _.1)) 565 | (assumption ((if _.0 _.1) _.2 _.3 _.4 _.0 . _.5) () 566 | _.0)) 567 | _.1) 568 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4))) 569 | (absento (closure _.0) (closure _.1) (closure _.2) 570 | (closure _.3) (closure _.4) (closure _.5))) 571 | ((modus-ponens ((if _.0 _.1) _.2 _.3 _.4 _.5 _.0 . _.6) 572 | ((assumption ((if _.0 _.1) _.2 _.3 _.4 _.5 _.0 . _.6) 573 | () (if _.0 _.1)) 574 | (assumption ((if _.0 _.1) _.2 _.3 _.4 _.5 _.0 . _.6) 575 | () _.0)) 576 | _.1) 577 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5))) 578 | (absento (closure _.0) (closure _.1) (closure _.2) 579 | (closure _.3) (closure _.4) (closure _.5) 580 | (closure _.6))) 581 | ((modus-ponens 582 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.0 . _.7) 583 | ((assumption 584 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.0 . _.7) () 585 | (if _.0 _.1)) 586 | (assumption 587 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.0 . _.7) () _.0)) 588 | _.1) 589 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 590 | ((_.0 _.6))) 591 | (absento (closure _.0) (closure _.1) (closure _.2) 592 | (closure _.3) (closure _.4) (closure _.5) 593 | (closure _.6) (closure _.7))) 594 | ((modus-ponens (_.0 (if _.1 _.2) _.1 . _.3) 595 | ((assumption (_.0 (if _.1 _.2) _.1 . _.3) () 596 | (if _.1 _.2)) 597 | (assumption (_.0 (if _.1 _.2) _.1 . _.3) () _.1)) 598 | _.2) 599 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2)))) 600 | (absento (closure _.0) (closure _.1) (closure _.2) 601 | (closure _.3))) 602 | ((modus-ponens (_.0 _.1 (if _.0 _.2) . _.3) 603 | ((assumption (_.0 _.1 (if _.0 _.2) . _.3) () 604 | (if _.0 _.2)) 605 | (assumption (_.0 _.1 (if _.0 _.2) . _.3) () _.0)) 606 | _.2) 607 | (=/= ((_.1 (if _.0 _.2)))) 608 | (absento (closure _.0) (closure _.1) (closure _.2) 609 | (closure _.3))) 610 | ((modus-ponens 611 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.0 . _.8) 612 | ((assumption 613 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.0 . _.8) () 614 | (if _.0 _.1)) 615 | (assumption 616 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.0 . _.8) () 617 | _.0)) 618 | _.1) 619 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 620 | ((_.0 _.6)) ((_.0 _.7))) 621 | (absento (closure _.0) (closure _.1) (closure _.2) 622 | (closure _.3) (closure _.4) (closure _.5) 623 | (closure _.6) (closure _.7) (closure _.8))) 624 | ((modus-ponens 625 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.0 . _.9) 626 | ((assumption 627 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.0 . _.9) 628 | () (if _.0 _.1)) 629 | (assumption 630 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.0 631 | . _.9) 632 | () _.0)) 633 | _.1) 634 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 635 | ((_.0 _.6)) ((_.0 _.7)) ((_.0 _.8))) 636 | (absento (closure _.0) (closure _.1) (closure _.2) 637 | (closure _.3) (closure _.4) (closure _.5) 638 | (closure _.6) (closure _.7) (closure _.8) 639 | (closure _.9))) 640 | ((modus-ponens (_.0 (if _.1 _.2) _.3 _.1 . _.4) 641 | ((assumption (_.0 (if _.1 _.2) _.3 _.1 . _.4) () 642 | (if _.1 _.2)) 643 | (assumption (_.0 (if _.1 _.2) _.3 _.1 . _.4) () _.1)) 644 | _.2) 645 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2))) ((_.1 _.3))) 646 | (absento (closure _.0) (closure _.1) (closure _.2) 647 | (closure _.3) (closure _.4))) 648 | ((modus-ponens 649 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.0 650 | . _.10) 651 | ((assumption 652 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.0 653 | . _.10) 654 | () (if _.0 _.1)) 655 | (assumption 656 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.0 657 | . _.10) 658 | () _.0)) 659 | _.1) 660 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 661 | ((_.0 _.6)) ((_.0 _.7)) ((_.0 _.8)) ((_.0 _.9))) 662 | (absento (closure _.0) (closure _.1) (closure _.10) 663 | (closure _.2) (closure _.3) (closure _.4) 664 | (closure _.5) (closure _.6) (closure _.7) 665 | (closure _.8) (closure _.9))) 666 | ((modus-ponens 667 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.0 668 | . _.11) 669 | ((assumption 670 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 671 | _.0 . _.11) 672 | () (if _.0 _.1)) 673 | (assumption 674 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 675 | _.0 . _.11) 676 | () _.0)) 677 | _.1) 678 | (=/= ((_.0 _.10)) ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) 679 | ((_.0 _.5)) ((_.0 _.6)) ((_.0 _.7)) ((_.0 _.8)) 680 | ((_.0 _.9))) 681 | (absento (closure _.0) (closure _.1) (closure _.10) 682 | (closure _.11) (closure _.2) (closure _.3) 683 | (closure _.4) (closure _.5) (closure _.6) 684 | (closure _.7) (closure _.8) (closure _.9))) 685 | ((modus-ponens (_.0 (if _.1 _.2) _.3 _.4 _.1 . _.5) 686 | ((assumption (_.0 (if _.1 _.2) _.3 _.4 _.1 . _.5) () 687 | (if _.1 _.2)) 688 | (assumption (_.0 (if _.1 _.2) _.3 _.4 _.1 . _.5) () 689 | _.1)) 690 | _.2) 691 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2))) ((_.1 _.3)) 692 | ((_.1 _.4))) 693 | (absento (closure _.0) (closure _.1) (closure _.2) 694 | (closure _.3) (closure _.4) (closure _.5))) 695 | ((modus-ponens (_.0 _.1 (if _.1 _.2) . _.3) 696 | ((assumption (_.0 _.1 (if _.1 _.2) . _.3) () 697 | (if _.1 _.2)) 698 | (assumption (_.0 _.1 (if _.1 _.2) . _.3) () _.1)) 699 | _.2) 700 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2)))) 701 | (absento (closure _.0) (closure _.1) (closure _.2) 702 | (closure _.3))) 703 | ((modus-ponens 704 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 705 | _.0 . _.12) 706 | ((assumption 707 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 708 | _.11 _.0 . _.12) 709 | () (if _.0 _.1)) 710 | (assumption 711 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 712 | _.11 _.0 . _.12) 713 | () _.0)) 714 | _.1) 715 | (=/= ((_.0 _.10)) ((_.0 _.11)) ((_.0 _.2)) ((_.0 _.3)) 716 | ((_.0 _.4)) ((_.0 _.5)) ((_.0 _.6)) ((_.0 _.7)) 717 | ((_.0 _.8)) ((_.0 _.9))) 718 | (absento (closure _.0) (closure _.1) (closure _.10) 719 | (closure _.11) (closure _.12) (closure _.2) 720 | (closure _.3) (closure _.4) (closure _.5) 721 | (closure _.6) (closure _.7) (closure _.8) 722 | (closure _.9))) 723 | ((modus-ponens 724 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 725 | _.12 _.0 . _.13) 726 | ((assumption 727 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 728 | _.11 _.12 _.0 . _.13) 729 | () (if _.0 _.1)) 730 | (assumption 731 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 732 | _.11 _.12 _.0 . _.13) 733 | () _.0)) 734 | _.1) 735 | (=/= ((_.0 _.10)) ((_.0 _.11)) ((_.0 _.12)) ((_.0 _.2)) 736 | ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) ((_.0 _.6)) 737 | ((_.0 _.7)) ((_.0 _.8)) ((_.0 _.9))) 738 | (absento (closure _.0) (closure _.1) (closure _.10) 739 | (closure _.11) (closure _.12) (closure _.13) 740 | (closure _.2) (closure _.3) (closure _.4) 741 | (closure _.5) (closure _.6) (closure _.7) 742 | (closure _.8) (closure _.9))) 743 | ((modus-ponens (_.0 (if _.1 _.2) _.3 _.4 _.5 _.1 . _.6) 744 | ((assumption (_.0 (if _.1 _.2) _.3 _.4 _.5 _.1 . _.6) 745 | () (if _.1 _.2)) 746 | (assumption (_.0 (if _.1 _.2) _.3 _.4 _.5 _.1 . _.6) 747 | () _.1)) 748 | _.2) 749 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2))) ((_.1 _.3)) 750 | ((_.1 _.4)) ((_.1 _.5))) 751 | (absento (closure _.0) (closure _.1) (closure _.2) 752 | (closure _.3) (closure _.4) (closure _.5) 753 | (closure _.6))) 754 | ((modus-ponens ((if _.0 _.0) _.0 . _.1) 755 | ((assumption ((if _.0 _.0) _.0 . _.1) () (if _.0 _.0)) 756 | (modus-ponens ((if _.0 _.0) _.0 . _.1) 757 | ((assumption ((if _.0 _.0) _.0 . _.1) () 758 | (if _.0 _.0)) 759 | (assumption ((if _.0 _.0) _.0 . _.1) () _.0)) 760 | _.0)) 761 | _.0) 762 | (absento (closure _.0) (closure _.1))))) 763 | 764 | ;; Here we generate *incorrect* proof trees. That is, proof trees 765 | ;; that *do not* prove the theorem from the given set of assumptions. 766 | ;; We do this simply by changing the last argument of 'eval-expo' to 767 | ;; #f instead of #t. In other words, we are inferring proofs for 768 | ;; which the 'proof?' function in Racket would return #f. 769 | 770 | ;; 15 collections 771 | ;; 29688 ms elapsed cpu time, including 2 ms collecting 772 | ;; 29691 ms elapsed real time, including 2 ms collecting 773 | ;; 120117040 bytes allocated 774 | (test "generate-non-theorems/proofs" 775 | (run 20 (prf) 776 | (eval-expo 777 | `(letrec ((member? (lambda (x ls) 778 | (if (null? ls) 779 | #f 780 | (if (equal? (car ls) x) 781 | #t 782 | (member? x (cdr ls))))))) 783 | (letrec ((proof? (lambda (proof) 784 | (match proof 785 | [`(assumption ,assms () ,A) 786 | (member? A assms)] 787 | [`(modus-ponens 788 | ,assms 789 | ((,r1 ,assms ,ants1 (if ,A ,B)) 790 | (,r2 ,assms ,ants2 ,A)) 791 | ,B) 792 | (and (proof? (list r1 assms ants1 (list 'if A B))) 793 | (proof? (list r2 assms ants2 A)))])))) 794 | (proof? ',prf))) 795 | '() 796 | #f)) 797 | '(((assumption () () _.0) (absento (closure _.0))) 798 | ((assumption (_.0) () _.1) (=/= ((_.0 _.1))) 799 | (absento (closure _.0) (closure _.1))) 800 | ((assumption (_.0 _.1) () _.2) 801 | (=/= ((_.0 _.2)) ((_.1 _.2))) 802 | (absento (closure _.0) (closure _.1) (closure _.2))) 803 | ((assumption (_.0 _.1 _.2) () _.3) 804 | (=/= ((_.0 _.3)) ((_.1 _.3)) ((_.2 _.3))) 805 | (absento (closure _.0) (closure _.1) (closure _.2) 806 | (closure _.3))) 807 | ((assumption (_.0 _.1 _.2 _.3) () _.4) 808 | (=/= ((_.0 _.4)) ((_.1 _.4)) ((_.2 _.4)) ((_.3 _.4))) 809 | (absento (closure _.0) (closure _.1) (closure _.2) 810 | (closure _.3) (closure _.4))) 811 | ((assumption (_.0 _.1 _.2 _.3 _.4) () _.5) 812 | (=/= ((_.0 _.5)) ((_.1 _.5)) ((_.2 _.5)) ((_.3 _.5)) 813 | ((_.4 _.5))) 814 | (absento (closure _.0) (closure _.1) (closure _.2) 815 | (closure _.3) (closure _.4) (closure _.5))) 816 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5) () _.6) 817 | (=/= ((_.0 _.6)) ((_.1 _.6)) ((_.2 _.6)) ((_.3 _.6)) 818 | ((_.4 _.6)) ((_.5 _.6))) 819 | (absento (closure _.0) (closure _.1) (closure _.2) 820 | (closure _.3) (closure _.4) (closure _.5) 821 | (closure _.6))) 822 | ((modus-ponens () 823 | ((assumption () () (if _.0 _.1)) (_.2 () _.3 _.0)) _.1) 824 | (absento (closure _.0) (closure _.1) (closure _.2) 825 | (closure _.3))) 826 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6) () _.7) 827 | (=/= ((_.0 _.7)) ((_.1 _.7)) ((_.2 _.7)) ((_.3 _.7)) 828 | ((_.4 _.7)) ((_.5 _.7)) ((_.6 _.7))) 829 | (absento (closure _.0) (closure _.1) (closure _.2) 830 | (closure _.3) (closure _.4) (closure _.5) 831 | (closure _.6) (closure _.7))) 832 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7) () _.8) 833 | (=/= ((_.0 _.8)) ((_.1 _.8)) ((_.2 _.8)) ((_.3 _.8)) 834 | ((_.4 _.8)) ((_.5 _.8)) ((_.6 _.8)) ((_.7 _.8))) 835 | (absento (closure _.0) (closure _.1) (closure _.2) 836 | (closure _.3) (closure _.4) (closure _.5) 837 | (closure _.6) (closure _.7) (closure _.8))) 838 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8) () _.9) 839 | (=/= ((_.0 _.9)) ((_.1 _.9)) ((_.2 _.9)) ((_.3 _.9)) 840 | ((_.4 _.9)) ((_.5 _.9)) ((_.6 _.9)) ((_.7 _.9)) 841 | ((_.8 _.9))) 842 | (absento (closure _.0) (closure _.1) (closure _.2) 843 | (closure _.3) (closure _.4) (closure _.5) 844 | (closure _.6) (closure _.7) (closure _.8) 845 | (closure _.9))) 846 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9) () 847 | _.10) 848 | (=/= ((_.0 _.10)) ((_.1 _.10)) ((_.10 _.2)) ((_.10 _.3)) 849 | ((_.10 _.4)) ((_.10 _.5)) ((_.10 _.6)) ((_.10 _.7)) 850 | ((_.10 _.8)) ((_.10 _.9))) 851 | (absento (closure _.0) (closure _.1) (closure _.10) 852 | (closure _.2) (closure _.3) (closure _.4) 853 | (closure _.5) (closure _.6) (closure _.7) 854 | (closure _.8) (closure _.9))) 855 | ((modus-ponens (_.0) 856 | ((assumption (_.0) () (if _.1 _.2)) (_.3 (_.0) _.4 _.1)) 857 | _.2) 858 | (=/= ((_.0 (if _.1 _.2)))) 859 | (absento (closure _.0) (closure _.1) (closure _.2) 860 | (closure _.3) (closure _.4))) 861 | ((assumption 862 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10) () _.11) 863 | (=/= ((_.0 _.11)) ((_.1 _.11)) ((_.10 _.11)) 864 | ((_.11 _.2)) ((_.11 _.3)) ((_.11 _.4)) ((_.11 _.5)) 865 | ((_.11 _.6)) ((_.11 _.7)) ((_.11 _.8)) ((_.11 _.9))) 866 | (absento (closure _.0) (closure _.1) (closure _.10) 867 | (closure _.11) (closure _.2) (closure _.3) 868 | (closure _.4) (closure _.5) (closure _.6) 869 | (closure _.7) (closure _.8) (closure _.9))) 870 | ((assumption 871 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11) () 872 | _.12) 873 | (=/= ((_.0 _.12)) ((_.1 _.12)) ((_.10 _.12)) 874 | ((_.11 _.12)) ((_.12 _.2)) ((_.12 _.3)) ((_.12 _.4)) 875 | ((_.12 _.5)) ((_.12 _.6)) ((_.12 _.7)) ((_.12 _.8)) 876 | ((_.12 _.9))) 877 | (absento (closure _.0) (closure _.1) (closure _.10) 878 | (closure _.11) (closure _.12) (closure _.2) 879 | (closure _.3) (closure _.4) (closure _.5) 880 | (closure _.6) (closure _.7) (closure _.8) 881 | (closure _.9))) 882 | ((assumption 883 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12) 884 | () _.13) 885 | (=/= ((_.0 _.13)) ((_.1 _.13)) ((_.10 _.13)) 886 | ((_.11 _.13)) ((_.12 _.13)) ((_.13 _.2)) ((_.13 _.3)) 887 | ((_.13 _.4)) ((_.13 _.5)) ((_.13 _.6)) ((_.13 _.7)) 888 | ((_.13 _.8)) ((_.13 _.9))) 889 | (absento (closure _.0) (closure _.1) (closure _.10) 890 | (closure _.11) (closure _.12) (closure _.13) 891 | (closure _.2) (closure _.3) (closure _.4) 892 | (closure _.5) (closure _.6) (closure _.7) 893 | (closure _.8) (closure _.9))) 894 | ((assumption 895 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 896 | _.13) 897 | () _.14) 898 | (=/= ((_.0 _.14)) ((_.1 _.14)) ((_.10 _.14)) 899 | ((_.11 _.14)) ((_.12 _.14)) ((_.13 _.14)) ((_.14 _.2)) 900 | ((_.14 _.3)) ((_.14 _.4)) ((_.14 _.5)) ((_.14 _.6)) 901 | ((_.14 _.7)) ((_.14 _.8)) ((_.14 _.9))) 902 | (absento (closure _.0) (closure _.1) (closure _.10) 903 | (closure _.11) (closure _.12) (closure _.13) 904 | (closure _.14) (closure _.2) (closure _.3) 905 | (closure _.4) (closure _.5) (closure _.6) 906 | (closure _.7) (closure _.8) (closure _.9))) 907 | ((modus-ponens (_.0 _.1) 908 | ((assumption (_.0 _.1) () (if _.2 _.3)) 909 | (_.4 (_.0 _.1) _.5 _.2)) 910 | _.3) 911 | (=/= ((_.0 (if _.2 _.3))) ((_.1 (if _.2 _.3)))) 912 | (absento (closure _.0) (closure _.1) (closure _.2) 913 | (closure _.3) (closure _.4) (closure _.5))) 914 | ((assumption 915 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 916 | _.13 _.14) 917 | () _.15) 918 | (=/= ((_.0 _.15)) ((_.1 _.15)) ((_.10 _.15)) 919 | ((_.11 _.15)) ((_.12 _.15)) ((_.13 _.15)) 920 | ((_.14 _.15)) ((_.15 _.2)) ((_.15 _.3)) ((_.15 _.4)) 921 | ((_.15 _.5)) ((_.15 _.6)) ((_.15 _.7)) ((_.15 _.8)) 922 | ((_.15 _.9))) 923 | (absento (closure _.0) (closure _.1) (closure _.10) 924 | (closure _.11) (closure _.12) (closure _.13) 925 | (closure _.14) (closure _.15) (closure _.2) 926 | (closure _.3) (closure _.4) (closure _.5) 927 | (closure _.6) (closure _.7) (closure _.8) 928 | (closure _.9))) 929 | ((assumption 930 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 931 | _.13 _.14 _.15) 932 | () _.16) 933 | (=/= ((_.0 _.16)) ((_.1 _.16)) ((_.10 _.16)) 934 | ((_.11 _.16)) ((_.12 _.16)) ((_.13 _.16)) 935 | ((_.14 _.16)) ((_.15 _.16)) ((_.16 _.2)) ((_.16 _.3)) 936 | ((_.16 _.4)) ((_.16 _.5)) ((_.16 _.6)) ((_.16 _.7)) 937 | ((_.16 _.8)) ((_.16 _.9))) 938 | (absento (closure _.0) (closure _.1) (closure _.10) 939 | (closure _.11) (closure _.12) (closure _.13) 940 | (closure _.14) (closure _.15) (closure _.16) 941 | (closure _.2) (closure _.3) (closure _.4) 942 | (closure _.5) (closure _.6) (closure _.7) 943 | (closure _.8) (closure _.9))))) 944 | -------------------------------------------------------------------------------- /interp-uber.scm: -------------------------------------------------------------------------------- 1 | ;; TODO 2 | ;; 3 | ;; * add quasiquote/unquote so we can easily and efficiently write 4 | ;; 'lambda' and 'fold' as macros. 5 | ;; 6 | ;; Moved apply earlier so we can run (I love you) and quines queries 7 | ;; inside of 'append' definition. 8 | 9 | (load "mk/mk.scm") 10 | 11 | ;; supports variadic lambda: (lambda x x) 12 | 13 | 14 | ;; letrec is based on Dan Friedman's code, using the "half-closure" 15 | ;; approach from Reynold's definitional interpreters 16 | 17 | (define empty-env '()) 18 | 19 | (define lookupo 20 | (lambda (x env t) 21 | (conde 22 | ((fresh (y v rest) 23 | (== `(ext-env ,y ,v ,rest) env) 24 | (conde 25 | ((== y x) (== v t)) 26 | ((=/= y x) (lookupo x rest t))))) 27 | ((fresh (defs rest) 28 | (== `(ext-rec ,defs ,rest) env) 29 | (lookup-ext-reco x defs env rest t)))))) 30 | 31 | (define lookup-ext-reco 32 | (lambda (x defs env rest t) 33 | (fresh (y lam-exp others) 34 | (conde 35 | ((== '() defs) (lookupo x rest t)) 36 | ((== `((,y ,lam-exp) . ,others) defs) 37 | (conde 38 | ((== y x) (== `(closure ,lam-exp ,env) t)) 39 | ((=/= y x) (lookup-ext-reco x others env rest t)))))))) 40 | 41 | (define not-in-envo 42 | (lambda (x env) 43 | (conde 44 | ((== empty-env env)) 45 | ((fresh (y v rest) 46 | (== `(ext-env ,y ,v ,rest) env) 47 | (=/= y x) 48 | (not-in-envo x rest))) 49 | ((fresh (defs rest) 50 | (== `(ext-rec ,defs ,rest) env) 51 | (not-in-defso x defs) 52 | (not-in-envo x rest)))))) 53 | 54 | (define not-in-defso 55 | (lambda (x defs) 56 | (conde 57 | ((== '() defs)) 58 | ((fresh (y lam-exp others) 59 | (== `((,y ,lam-exp) . ,others) defs) 60 | (=/= y x) 61 | (not-in-defso x others)))))) 62 | 63 | (define eval-listo 64 | (lambda (exp env val) 65 | (conde 66 | ((== '() exp) 67 | (== '() val)) 68 | ((fresh (a d v-a v-d) 69 | (== `(,a . ,d) exp) 70 | (== `(,v-a . ,v-d) val) 71 | (eval-expo a env v-a) 72 | (eval-listo d env v-d)))))) 73 | 74 | ;; need to make sure lambdas are well formed. 75 | ;; grammar constraints would be useful here!!! 76 | (define list-of-symbolso 77 | (lambda (los) 78 | (conde 79 | ((== '() los)) 80 | ((fresh (a d) 81 | (== `(,a . ,d) los) 82 | (symbolo a) 83 | (list-of-symbolso d)))))) 84 | 85 | (define listo 86 | (lambda (ls) 87 | (conde 88 | ((== '() ls)) 89 | ((fresh (a d) 90 | (== `(,a . ,d) ls) 91 | (listo d)))))) 92 | 93 | (define evalo 94 | (lambda (exp val) 95 | (eval-expo exp empty-env val))) 96 | 97 | (define eval-expo 98 | (lambda (exp env val) 99 | (conde 100 | 101 | ((== `(quote ,val) exp) 102 | (absento 'closure val) 103 | (not-in-envo 'quote env)) 104 | 105 | ((numbero exp) (== exp val)) 106 | 107 | ((symbolo exp) (lookupo exp env val)) 108 | 109 | ;; should possibly combine these lambda clauses, application clauses, apply clauses, and letrec clauses 110 | 111 | ((fresh (x body) 112 | (== `(lambda ,x ,body) exp) 113 | (== `(closure (lambda ,x ,body) ,env) val) 114 | (symbolo x) 115 | (not-in-envo 'lambda env))) 116 | 117 | ((fresh (x* body) 118 | (== `(lambda ,x* ,body) exp) 119 | (== `(closure (lambda ,x* ,body) ,env) val) 120 | (list-of-symbolso x*) 121 | (not-in-envo 'lambda env))) 122 | 123 | ((fresh (a*) 124 | (== `(list . ,a*) exp) 125 | (not-in-envo 'list env) 126 | (eval-listo a* env val))) 127 | 128 | ;; apply for variadic procedure 129 | ((fresh (e e* x body env^ a* res) 130 | (== `(apply ,e ,e*) exp) 131 | (not-in-envo 'apply env) 132 | (symbolo x) 133 | (== `(ext-env ,x ,a* ,env^) res) 134 | (eval-expo e env `(closure (lambda ,x ,body) ,env^)) 135 | (eval-expo e* env a*) 136 | (listo a*) 137 | (eval-expo body res val))) 138 | 139 | ;; apply for mult-argument procedure 140 | ((fresh (e e* x x* body env^ a* res) 141 | (== `(apply ,e ,e*) exp) 142 | (not-in-envo 'apply env) 143 | (symbolo x) 144 | (ext-env*o `(,x . ,x*) a* env^ res) 145 | (eval-expo e env `(closure (lambda (,x . ,x*) ,body) ,env^)) 146 | (eval-expo e* env a*) 147 | (listo a*) 148 | (eval-expo body res val))) 149 | 150 | ((fresh (against-expr against-val clause clauses) 151 | (== `(match ,against-expr ,clause . ,clauses) exp) 152 | (not-in-envo 'match env) 153 | (eval-expo against-expr env against-val) 154 | (match-clauses against-val `(,clause . ,clauses) env val))) 155 | 156 | ((fresh (rator x rands body env^ a* res) 157 | (== `(,rator . ,rands) exp) 158 | (symbolo x) 159 | (== `(ext-env ,x ,a* ,env^) res) 160 | (eval-expo rator env `(closure (lambda ,x ,body) ,env^)) 161 | 162 | (eval-expo body res val) ;; perfect example of two serious 163 | ;; calls in which it isn't clear 164 | ;; which one should come first 165 | (eval-listo rands env a*))) 166 | 167 | ((fresh (rator x* rands body env^ a* res) 168 | (== `(,rator . ,rands) exp) 169 | (eval-expo rator env `(closure (lambda ,x* ,body) ,env^)) 170 | (eval-listo rands env a*) 171 | (ext-env*o x* a* env^ res) 172 | (eval-expo body res val))) 173 | 174 | ((fresh (p-name x body letrec-body) 175 | (== `(letrec ((,p-name (lambda ,x ,body))) ;; single-function variadic letrec version 176 | ,letrec-body) 177 | exp) 178 | (symbolo x) 179 | (not-in-envo 'letrec env) 180 | (eval-expo letrec-body 181 | `(ext-rec ((,p-name (lambda ,x ,body))) ,env) 182 | val))) 183 | 184 | ((fresh (p-name x* body letrec-body) 185 | (== `(letrec ((,p-name (lambda ,x* ,body))) ;; single-function multiple-argument letrec version 186 | ,letrec-body) 187 | exp) 188 | (list-of-symbolso x*) 189 | (not-in-envo 'letrec env) 190 | (eval-expo letrec-body 191 | `(ext-rec ((,p-name (lambda ,x* ,body))) ,env) 192 | val))) 193 | 194 | ;;; don't comment this out accidentally!!! 195 | ((prim-expo exp env val)) 196 | 197 | ))) 198 | 199 | (define ext-env*o 200 | (lambda (x* a* env out) 201 | (conde 202 | ((== '() x*) (== '() a*) (== env out)) 203 | ((fresh (x a dx* da* env2) 204 | (== `(,x . ,dx*) x*) 205 | (== `(,a . ,da*) a*) 206 | (== `(ext-env ,x ,a ,env) env2) 207 | (symbolo x) 208 | (ext-env*o dx* da* env2 out)))))) 209 | 210 | (define prim-expo 211 | (lambda (exp env val) 212 | (conde 213 | ((boolean-primo exp env val)) 214 | ((and-primo exp env val)) 215 | ((or-primo exp env val)) 216 | ((null?-primo exp env val)) 217 | ((symbol?-primo exp env val)) 218 | ((not-primo exp env val)) 219 | ((car-primo exp env val)) 220 | ((cdr-primo exp env val)) 221 | ((cons-primo exp env val)) 222 | ((equal?-primo exp env val)) 223 | ((if-primo exp env val))))) 224 | 225 | (define boolean-primo 226 | (lambda (exp env val) 227 | (conde 228 | ((== #t exp) (== #t val)) 229 | ((== #f exp) (== #f val))))) 230 | 231 | (define and-primo 232 | (lambda (exp env val) 233 | (fresh (e*) 234 | (== `(and . ,e*) exp) 235 | (not-in-envo 'and env) 236 | (ando e* env val)))) 237 | 238 | (define ando 239 | (lambda (e* env val) 240 | (conde 241 | ((== '() e*) (== #t val)) 242 | ((fresh (e) 243 | (== `(,e) e*) 244 | (eval-expo e env val))) 245 | ((fresh (e1 e2 e-rest v) 246 | (== `(,e1 ,e2 . ,e-rest) e*) 247 | (conde 248 | ((== #f v) 249 | (== #f val) 250 | (eval-expo e1 env v)) 251 | ((=/= #f v) 252 | (eval-expo e1 env v) 253 | (ando `(,e2 . ,e-rest) env val)))))))) 254 | 255 | (define or-primo 256 | (lambda (exp env val) 257 | (fresh (e*) 258 | (== `(or . ,e*) exp) 259 | (not-in-envo 'or env) 260 | (oro e* env val)))) 261 | 262 | (define oro 263 | (lambda (e* env val) 264 | (conde 265 | ((== '() e*) (== #f val)) 266 | ((fresh (e) 267 | (== `(,e) e*) 268 | (eval-expo e env val))) 269 | ((fresh (e1 e2 e-rest v) 270 | (== `(,e1 ,e2 . ,e-rest) e*) 271 | (conde 272 | ((=/= #f v) 273 | (== v val) 274 | (eval-expo e1 env v)) 275 | ((== #f v) 276 | (eval-expo e1 env v) 277 | (oro `(,e2 . ,e-rest) env val)))))))) 278 | 279 | 280 | (define equal?-primo 281 | (lambda (exp env val) 282 | (fresh (e1 e2 v1 v2) 283 | (== `(equal? ,e1 ,e2) exp) 284 | (conde 285 | ((== v1 v2) (== #t val)) 286 | ((=/= v1 v2) (== #f val))) 287 | (not-in-envo 'equal? env) 288 | (eval-expo e1 env v1) 289 | (eval-expo e2 env v2)))) 290 | 291 | (define cons-primo 292 | (lambda (exp env val) 293 | (fresh (a d v-a v-d) 294 | (== `(cons ,a ,d) exp) 295 | (== `(,v-a . ,v-d) val) 296 | (not-in-envo 'cons env) 297 | (eval-expo a env v-a) 298 | (eval-expo d env v-d)))) 299 | 300 | (define car-primo 301 | (lambda (exp env val) 302 | (fresh (p a d) 303 | (== `(car ,p) exp) 304 | (== a val) 305 | (=/= 'closure a) 306 | (not-in-envo 'car env) 307 | (eval-expo p env `(,a . ,d))))) 308 | 309 | (define cdr-primo 310 | (lambda (exp env val) 311 | (fresh (p a d) 312 | (== `(cdr ,p) exp) 313 | (== d val) 314 | (=/= 'closure a) 315 | (not-in-envo 'cdr env) 316 | (eval-expo p env `(,a . ,d))))) 317 | 318 | (define not-primo 319 | (lambda (exp env val) 320 | (fresh (e b) 321 | (== `(not ,e) exp) 322 | (conde 323 | ((=/= #f b) (== #f val)) 324 | ((== #f b) (== #t val))) 325 | (not-in-envo 'not env) 326 | (eval-expo e env b)))) 327 | 328 | (define symbol?-primo 329 | (lambda (exp env val) 330 | (fresh (e v) 331 | (== `(symbol? ,e) exp) 332 | (conde 333 | ((symbolo v) (== #t val)) 334 | ((numbero v) (== #f val)) 335 | ((fresh (a d) 336 | (== `(,a . ,d) v) 337 | (== #f val)))) 338 | (not-in-envo 'symbol? env) 339 | (eval-expo e env v)))) 340 | 341 | (define null?-primo 342 | (lambda (exp env val) 343 | (fresh (e v) 344 | (== `(null? ,e) exp) 345 | (conde 346 | ((== '() v) (== #t val)) 347 | ((=/= '() v) (== #f val))) 348 | (not-in-envo 'null? env) 349 | (eval-expo e env v)))) 350 | 351 | (define if-primo 352 | (lambda (exp env val) 353 | (fresh (e1 e2 e3 t) 354 | (== `(if ,e1 ,e2 ,e3) exp) 355 | (not-in-envo 'if env) 356 | (eval-expo e1 env t) 357 | (conde 358 | ((=/= #f t) (eval-expo e2 env val)) 359 | ((== #f t) (eval-expo e3 env val)))))) 360 | 361 | 362 | 363 | ;; match-related code 364 | 365 | ;; really should be a constraint built into miniKanren 366 | (define not-symbolo 367 | (lambda (t) 368 | (conde 369 | [(== #f t)] 370 | [(== #t t)] 371 | [(numbero t)] 372 | [(fresh (a d) 373 | (== `(,a . ,d) t))]))) 374 | 375 | (define not-numbero 376 | (lambda (t) 377 | (conde 378 | [(== #f t)] 379 | [(== #t t)] 380 | [(symbolo t)] 381 | [(fresh (a d) 382 | (== `(,a . ,d) t))]))) 383 | 384 | (define self-eval-literalo 385 | (lambda (t) 386 | (conde 387 | [(numbero t)] 388 | [(booleano t)]))) 389 | 390 | (define literalo 391 | (lambda (t) 392 | (conde 393 | [(numbero t)] 394 | [(symbolo t)] 395 | [(booleano t)] 396 | [(== '() t)]))) 397 | 398 | (define booleano 399 | (lambda (t) 400 | (conde 401 | [(== #f t)] 402 | [(== #t t)]))) 403 | 404 | 405 | (define (regular-env-appendo env1 env2 env-out) 406 | (conde 407 | [(== empty-env env1) (== env2 env-out)] 408 | [(fresh (y v rest res) 409 | (== `(ext-env ,y ,v ,rest) env1) 410 | (== `(ext-env ,y ,v ,res) env-out) 411 | (regular-env-appendo rest env2 res))])) 412 | 413 | 414 | (define (match-clauses against-val clauses env val) 415 | (fresh (top-pattern result-expr d penv) 416 | (== `((,top-pattern ,result-expr) . ,d) clauses) 417 | (conde 418 | [(fresh (env^) 419 | (top-pattern-matches top-pattern against-val '() penv) 420 | (regular-env-appendo penv env env^) 421 | (eval-expo result-expr env^ val))] 422 | [(top-pattern-but-doesnt-match top-pattern against-val '() penv) 423 | (match-clauses against-val d env val)]))) 424 | 425 | 426 | 427 | (define (top-pattern-matches top-pattern against-val penv penv-out) 428 | (conde 429 | [(self-eval-literalo top-pattern) (== top-pattern against-val) (== penv penv-out)] 430 | [(pattern-matches top-pattern against-val penv penv-out)] 431 | [(fresh (quasi-pattern) 432 | (== (list 'quasiquote quasi-pattern) top-pattern) 433 | (quasi-pattern-matches quasi-pattern against-val penv penv-out))])) 434 | 435 | (define (top-pattern-but-doesnt-match top-pattern against-val penv penv-out) 436 | (conde 437 | [(self-eval-literalo top-pattern) (=/= top-pattern against-val) (== penv penv-out)] 438 | [(pattern-but-doesnt-match top-pattern against-val penv penv-out)] 439 | [(fresh (quasi-pattern) 440 | (== (list 'quasiquote quasi-pattern) top-pattern) 441 | (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out))])) 442 | 443 | 444 | (define (var-pattern-matches var against-val penv penv-out) 445 | (fresh (val) 446 | (symbolo var) 447 | (conde 448 | [(== against-val val) 449 | (== penv penv-out) 450 | (lookupo var penv val)] 451 | [(== `(ext-env ,var ,against-val ,penv) penv-out) 452 | (not-in-envo var penv)]))) 453 | 454 | (define (var-pattern-but-doesnt-match var against-val penv penv-out) 455 | (fresh (val) 456 | (symbolo var) 457 | (=/= against-val val) 458 | (== penv penv-out) 459 | (lookupo var penv val))) 460 | 461 | 462 | 463 | (define (pattern-matches pattern against-val penv penv-out) 464 | (conde 465 | [(var-pattern-matches pattern against-val penv penv-out)] 466 | [(fresh (var pred val) 467 | (== `(? ,pred ,var) pattern) 468 | (conde 469 | [(== 'symbol? pred) 470 | (symbolo against-val)] 471 | [(== 'number? pred) 472 | (numbero against-val)]) 473 | (var-pattern-matches var against-val penv penv-out))])) 474 | 475 | (define (pattern-but-doesnt-match pattern against-val penv penv-out) 476 | (conde 477 | [(var-pattern-but-doesnt-match pattern against-val penv penv-out)] 478 | [(fresh (var pred val) 479 | (== `(? ,pred ,var) pattern) 480 | (== penv penv-out) 481 | (symbolo var) 482 | (conde 483 | [(== 'symbol? pred) 484 | (conde 485 | [(not-symbolo against-val)] 486 | [(symbolo against-val) 487 | (var-pattern-but-doesnt-match var against-val penv penv-out)])] 488 | [(== 'number? pred) 489 | (conde 490 | [(not-numbero against-val)] 491 | [(numbero against-val) 492 | (var-pattern-but-doesnt-match var against-val penv penv-out)])]))])) 493 | 494 | 495 | 496 | (define (quasi-pattern-matches quasi-pattern against-val penv penv-out) 497 | (conde 498 | [(== quasi-pattern against-val) 499 | (== penv penv-out) 500 | (literalo quasi-pattern)] 501 | [(fresh (pattern) 502 | (== (list 'unquote pattern) quasi-pattern) 503 | (pattern-matches pattern against-val penv penv-out))] 504 | [(fresh (a d v1 v2 penv^) 505 | (== `(,a . ,d) quasi-pattern) 506 | (== `(,v1 . ,v2) against-val) 507 | (=/= 'unquote a) 508 | (quasi-pattern-matches a v1 penv penv^) 509 | (quasi-pattern-matches d v2 penv^ penv-out))])) 510 | 511 | (define (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out) 512 | (conde 513 | [(=/= quasi-pattern against-val) 514 | (== penv penv-out) 515 | (literalo quasi-pattern)] 516 | [(fresh (pattern) 517 | (== (list 'unquote pattern) quasi-pattern) 518 | (pattern-but-doesnt-match pattern against-val penv penv-out))] 519 | [(fresh (a d) 520 | (== `(,a . ,d) quasi-pattern) 521 | (=/= 'unquote a) 522 | (conde 523 | [(== penv penv-out) 524 | (literalo against-val)] 525 | [(fresh (v1 v2 penv^) 526 | (== `(,v1 . ,v2) against-val) 527 | (conde 528 | [(quasi-pattern-but-doesnt-match a v1 penv penv^)] 529 | [(quasi-pattern-matches a v1 penv penv^) 530 | (quasi-pattern-but-doesnt-match d v2 penv^ penv-out)]))]))])) 531 | -------------------------------------------------------------------------------- /interp-with-variadic-lambda-and-map-and-match.scm: -------------------------------------------------------------------------------- 1 | ;; TODO 2 | ;; 3 | ;; * add quasiquote/unquote so we can easily and efficiently write 4 | ;; 'lambda' and 'fold' as macros. 5 | 6 | (load "mk/mk.scm") 7 | 8 | ;; supports variadic lambda: (lambda x x) 9 | 10 | 11 | ;; letrec is based on Dan Friedman's code, using the "half-closure" 12 | ;; approach from Reynold's definitional interpreters 13 | 14 | (define empty-env '()) 15 | 16 | (define lookupo 17 | (lambda (x env t) 18 | (conde 19 | ((fresh (y v rest) 20 | (== `(ext-env ,y ,v ,rest) env) 21 | (conde 22 | ((== y x) (== v t)) 23 | ((=/= y x) (lookupo x rest t))))) 24 | 25 | ((fresh (defs rest) 26 | (== `(ext-rec ,defs ,rest) env) 27 | (lookup-ext-reco x defs env rest t))) 28 | 29 | ))) 30 | 31 | (define lookup-ext-reco 32 | (lambda (x defs env rest t) 33 | (fresh (y lam-exp others) 34 | (conde 35 | ((== '() defs) (lookupo x rest t)) 36 | ((== `((,y ,lam-exp) . ,others) defs) 37 | (conde 38 | ((== y x) (== `(closure ,lam-exp ,env) t)) 39 | ((=/= y x) (lookup-ext-reco x others env rest t)))))))) 40 | 41 | (define not-in-envo 42 | (lambda (x env) 43 | (conde 44 | ((== empty-env env)) 45 | ((fresh (y v rest) 46 | (== `(ext-env ,y ,v ,rest) env) 47 | (=/= y x) 48 | (not-in-envo x rest))) 49 | 50 | ((fresh (defs rest) 51 | (== `(ext-rec ,defs ,rest) env) 52 | (not-in-defso x defs) 53 | (not-in-envo x rest))) 54 | 55 | ))) 56 | 57 | (define not-in-defso 58 | (lambda (x defs) 59 | (conde 60 | ((== '() defs)) 61 | ((fresh (y lam-exp others) 62 | (== `((,y ,lam-exp) . ,others) defs) 63 | (=/= y x) 64 | (not-in-defso x others)))))) 65 | 66 | (define eval-listo 67 | (lambda (exp env val) 68 | (conde 69 | ((== '() exp) 70 | (== '() val)) 71 | ((fresh (a d v-a v-d) 72 | (== `(,a . ,d) exp) 73 | (== `(,v-a . ,v-d) val) 74 | (eval-expo a env v-a) 75 | (eval-listo d env v-d)))))) 76 | 77 | ;; need to make sure lambdas are well formed. 78 | ;; grammar constraints would be useful here!!! 79 | (define list-of-symbolso 80 | (lambda (los) 81 | (conde 82 | ((== '() los)) 83 | ((fresh (a d) 84 | (== `(,a . ,d) los) 85 | (symbolo a) 86 | (list-of-symbolso d)))))) 87 | 88 | 89 | 90 | ;; restricted to single-argument closures 91 | (define mapo 92 | (lambda (x body env^ ls val) 93 | (conde 94 | ((== '() ls) (== '() val)) 95 | ((fresh (a d v res) 96 | (== `(,a . ,d) ls) 97 | (== `(,v . ,res) val) 98 | (eval-expo body `(ext-env ,x ,a ,env^) v) 99 | (mapo x body env^ d res)))))) 100 | 101 | 102 | 103 | (define listo 104 | (lambda (ls) 105 | (conde 106 | ((== '() ls)) 107 | ((fresh (a d) 108 | (== `(,a . ,d) ls) 109 | (listo d)))))) 110 | 111 | (define evalo 112 | (lambda (exp val) 113 | (eval-expo exp empty-env val))) 114 | 115 | (define eval-expo 116 | (lambda (exp env val) 117 | (conde 118 | 119 | ((== `(quote ,val) exp) 120 | (absento 'closure val) 121 | (not-in-envo 'quote env)) 122 | 123 | ((numbero exp) (== exp val)) 124 | 125 | ((symbolo exp) (lookupo exp env val)) 126 | 127 | ;; should possibly combine these lambda clauses, application clauses, apply clauses, and letrec clauses 128 | 129 | ((fresh (x body) 130 | (== `(lambda ,x ,body) exp) 131 | (== `(closure (lambda ,x ,body) ,env) val) 132 | (symbolo x) 133 | (not-in-envo 'lambda env))) 134 | 135 | ((fresh (x* body) 136 | (== `(lambda ,x* ,body) exp) 137 | (== `(closure (lambda ,x* ,body) ,env) val) 138 | (list-of-symbolso x*) 139 | (not-in-envo 'lambda env))) 140 | 141 | ((fresh (f-e ls-e f ls x body env^) 142 | ;; map handles single-argument functions only 143 | (== `(map ,f-e ,ls-e) exp) 144 | (not-in-envo 'map env) 145 | (== `(closure (lambda (,x) ,body) ,env^) f) 146 | (symbolo x) 147 | (eval-expo f-e env f) 148 | (eval-expo ls-e env ls) 149 | (mapo x body env^ ls val))) 150 | 151 | ((fresh (a*) 152 | (== `(list . ,a*) exp) 153 | (not-in-envo 'list env) 154 | (eval-listo a* env val))) 155 | 156 | ((fresh (against-expr against-val clause clauses) 157 | (== `(match ,against-expr ,clause . ,clauses) exp) 158 | (not-in-envo 'match env) 159 | (eval-expo against-expr env against-val) 160 | (match-clauses against-val `(,clause . ,clauses) env val))) 161 | 162 | ((fresh (rator x rands body env^ a* res) 163 | (== `(,rator . ,rands) exp) 164 | (symbolo x) 165 | (== `(ext-env ,x ,a* ,env^) res) 166 | (eval-expo rator env `(closure (lambda ,x ,body) ,env^)) 167 | 168 | (eval-expo body res val) ;; perfect example of two serious 169 | ;; calls in which it isn't clear 170 | ;; which one should come first 171 | (eval-listo rands env a*))) 172 | 173 | ((fresh (rator x* rands body env^ a* res) 174 | (== `(,rator . ,rands) exp) 175 | (eval-expo rator env `(closure (lambda ,x* ,body) ,env^)) 176 | (eval-listo rands env a*) 177 | (ext-env*o x* a* env^ res) 178 | (eval-expo body res val))) 179 | 180 | ((fresh (p-name x body letrec-body) 181 | (== `(letrec ((,p-name (lambda ,x ,body))) ;; single-function variadic letrec version 182 | ,letrec-body) 183 | exp) 184 | (symbolo x) 185 | (not-in-envo 'letrec env) 186 | (eval-expo letrec-body 187 | `(ext-rec ((,p-name (lambda ,x ,body))) ,env) 188 | val))) 189 | 190 | ((fresh (p-name x* body letrec-body) 191 | (== `(letrec ((,p-name (lambda ,x* ,body))) ;; single-function multiple-argument letrec version 192 | ,letrec-body) 193 | exp) 194 | (list-of-symbolso x*) 195 | (not-in-envo 'letrec env) 196 | (eval-expo letrec-body 197 | `(ext-rec ((,p-name (lambda ,x* ,body))) ,env) 198 | val))) 199 | 200 | ;;; don't comment this out accidentally!!! 201 | ((prim-expo exp env val)) 202 | 203 | 204 | ;; apply for variadic procedure 205 | ((fresh (e e* x body env^ a* res) 206 | (== `(apply ,e ,e*) exp) 207 | (not-in-envo 'apply env) 208 | (symbolo x) 209 | (== `(ext-env ,x ,a* ,env^) res) 210 | (eval-expo e env `(closure (lambda ,x ,body) ,env^)) 211 | (eval-expo e* env a*) 212 | (listo a*) 213 | (eval-expo body res val))) 214 | 215 | ;; apply for mult-argument procedure 216 | ((fresh (e e* x x* body env^ a* res) 217 | (== `(apply ,e ,e*) exp) 218 | (not-in-envo 'apply env) 219 | (symbolo x) 220 | (ext-env*o `(,x . ,x*) a* env^ res) 221 | (eval-expo e env `(closure (lambda (,x . ,x*) ,body) ,env^)) 222 | (eval-expo e* env a*) 223 | (listo a*) 224 | (eval-expo body res val))) 225 | 226 | ))) 227 | 228 | (define ext-env*o 229 | (lambda (x* a* env out) 230 | (conde 231 | ((== '() x*) (== '() a*) (== env out)) 232 | ((fresh (x a dx* da* env2) 233 | (== `(,x . ,dx*) x*) 234 | (== `(,a . ,da*) a*) 235 | (== `(ext-env ,x ,a ,env) env2) 236 | (symbolo x) 237 | (ext-env*o dx* da* env2 out)))))) 238 | 239 | (define prim-expo 240 | (lambda (exp env val) 241 | (conde 242 | ((boolean-primo exp env val)) 243 | ((null?-primo exp env val)) 244 | ((symbol?-primo exp env val)) 245 | ((not-primo exp env val)) 246 | ((car-primo exp env val)) 247 | ((cdr-primo exp env val)) 248 | ((cons-primo exp env val)) 249 | ((equal?-primo exp env val)) 250 | ((if-primo exp env val))))) 251 | 252 | (define boolean-primo 253 | (lambda (exp env val) 254 | (conde 255 | ((== #t exp) (== #t val)) 256 | ((== #f exp) (== #f val))))) 257 | 258 | (define equal?-primo 259 | (lambda (exp env val) 260 | (fresh (e1 e2 v1 v2) 261 | (== `(equal? ,e1 ,e2) exp) 262 | (conde 263 | ((== v1 v2) (== #t val)) 264 | ((=/= v1 v2) (== #f val))) 265 | (not-in-envo 'equal? env) 266 | (eval-expo e1 env v1) 267 | (eval-expo e2 env v2)))) 268 | 269 | (define cons-primo 270 | (lambda (exp env val) 271 | (fresh (a d v-a v-d) 272 | (== `(cons ,a ,d) exp) 273 | (== `(,v-a . ,v-d) val) 274 | (not-in-envo 'cons env) 275 | (eval-expo a env v-a) 276 | (eval-expo d env v-d)))) 277 | 278 | (define car-primo 279 | (lambda (exp env val) 280 | (fresh (p a d) 281 | (== `(car ,p) exp) 282 | (== a val) 283 | (=/= 'closure a) 284 | (not-in-envo 'car env) 285 | (eval-expo p env `(,a . ,d))))) 286 | 287 | (define cdr-primo 288 | (lambda (exp env val) 289 | (fresh (p a d) 290 | (== `(cdr ,p) exp) 291 | (== d val) 292 | (=/= 'closure a) 293 | (not-in-envo 'cdr env) 294 | (eval-expo p env `(,a . ,d))))) 295 | 296 | (define not-primo 297 | (lambda (exp env val) 298 | (fresh (e b) 299 | (== `(not ,e) exp) 300 | (conde 301 | ((=/= #f b) (== #f val)) 302 | ((== #f b) (== #t val))) 303 | (not-in-envo 'not env) 304 | (eval-expo e env b)))) 305 | 306 | (define symbol?-primo 307 | (lambda (exp env val) 308 | (fresh (e v) 309 | (== `(symbol? ,e) exp) 310 | (conde 311 | ((symbolo v) (== #t val)) 312 | ((numbero v) (== #f val)) 313 | ((fresh (a d) 314 | (== `(,a . ,d) v) 315 | (== #f val)))) 316 | (not-in-envo 'symbol? env) 317 | (eval-expo e env v)))) 318 | 319 | (define null?-primo 320 | (lambda (exp env val) 321 | (fresh (e v) 322 | (== `(null? ,e) exp) 323 | (conde 324 | ((== '() v) (== #t val)) 325 | ((=/= '() v) (== #f val))) 326 | (not-in-envo 'null? env) 327 | (eval-expo e env v)))) 328 | 329 | (define if-primo 330 | (lambda (exp env val) 331 | (fresh (e1 e2 e3 t) 332 | (== `(if ,e1 ,e2 ,e3) exp) 333 | (not-in-envo 'if env) 334 | (eval-expo e1 env t) 335 | (conde 336 | ((=/= #f t) (eval-expo e2 env val)) 337 | ((== #f t) (eval-expo e3 env val)))))) 338 | 339 | 340 | 341 | ;; match-related code 342 | 343 | ;; really should be a constraint built into miniKanren 344 | (define not-symbolo 345 | (lambda (t) 346 | (conde 347 | [(== #f t)] 348 | [(== #t t)] 349 | [(numbero t)] 350 | [(fresh (a d) 351 | (== `(,a . ,d) t))]))) 352 | 353 | (define not-numbero 354 | (lambda (t) 355 | (conde 356 | [(== #f t)] 357 | [(== #t t)] 358 | [(symbolo t)] 359 | [(fresh (a d) 360 | (== `(,a . ,d) t))]))) 361 | 362 | (define self-eval-literalo 363 | (lambda (t) 364 | (conde 365 | [(numbero t)] 366 | [(booleano t)]))) 367 | 368 | (define literalo 369 | (lambda (t) 370 | (conde 371 | [(numbero t)] 372 | [(symbolo t)] 373 | [(booleano t)] 374 | [(== '() t)]))) 375 | 376 | (define booleano 377 | (lambda (t) 378 | (conde 379 | [(== #f t)] 380 | [(== #t t)]))) 381 | 382 | 383 | (define (regular-env-appendo env1 env2 env-out) 384 | (conde 385 | [(== empty-env env1) (== env2 env-out)] 386 | [(fresh (y v rest res) 387 | (== `(ext-env ,y ,v ,rest) env1) 388 | (== `(ext-env ,y ,v ,res) env-out) 389 | (regular-env-appendo rest env2 res))])) 390 | 391 | 392 | (define (match-clauses against-val clauses env val) 393 | (fresh (top-pattern result-expr d penv) 394 | (== `((,top-pattern ,result-expr) . ,d) clauses) 395 | (conde 396 | [(fresh (env^) 397 | (top-pattern-matches top-pattern against-val '() penv) 398 | (regular-env-appendo penv env env^) 399 | (eval-expo result-expr env^ val))] 400 | [(top-pattern-but-doesnt-match top-pattern against-val '() penv) 401 | (match-clauses against-val d env val)]))) 402 | 403 | 404 | 405 | (define (top-pattern-matches top-pattern against-val penv penv-out) 406 | (conde 407 | [(self-eval-literalo top-pattern) (== top-pattern against-val) (== penv penv-out)] 408 | [(pattern-matches top-pattern against-val penv penv-out)] 409 | [(fresh (quasi-pattern) 410 | (== (list 'quasiquote quasi-pattern) top-pattern) 411 | (quasi-pattern-matches quasi-pattern against-val penv penv-out))])) 412 | 413 | (define (top-pattern-but-doesnt-match top-pattern against-val penv penv-out) 414 | (conde 415 | [(self-eval-literalo top-pattern) (=/= top-pattern against-val) (== penv penv-out)] 416 | [(pattern-but-doesnt-match top-pattern against-val penv penv-out)] 417 | [(fresh (quasi-pattern) 418 | (== (list 'quasiquote quasi-pattern) top-pattern) 419 | (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out))])) 420 | 421 | 422 | (define (var-pattern-matches var against-val penv penv-out) 423 | (fresh (val) 424 | (symbolo var) 425 | (conde 426 | [(== against-val val) 427 | (== penv penv-out) 428 | (lookupo var penv val)] 429 | [(== `(ext-env ,var ,against-val ,penv) penv-out) 430 | (not-in-envo var penv)]))) 431 | 432 | (define (var-pattern-but-doesnt-match var against-val penv penv-out) 433 | (fresh (val) 434 | (symbolo var) 435 | (=/= against-val val) 436 | (== penv penv-out) 437 | (lookupo var penv val))) 438 | 439 | 440 | 441 | (define (pattern-matches pattern against-val penv penv-out) 442 | (conde 443 | [(var-pattern-matches pattern against-val penv penv-out)] 444 | [(fresh (var pred val) 445 | (== `(? ,pred ,var) pattern) 446 | (conde 447 | [(== 'symbol? pred) 448 | (symbolo against-val)] 449 | [(== 'number? pred) 450 | (numbero against-val)]) 451 | (var-pattern-matches var against-val penv penv-out))])) 452 | 453 | (define (pattern-but-doesnt-match pattern against-val penv penv-out) 454 | (conde 455 | [(var-pattern-but-doesnt-match pattern against-val penv penv-out)] 456 | [(fresh (var pred val) 457 | (== `(? ,pred ,var) pattern) 458 | (== penv penv-out) 459 | (symbolo var) 460 | (conde 461 | [(== 'symbol? pred) 462 | (conde 463 | [(not-symbolo against-val)] 464 | [(symbolo against-val) 465 | (var-pattern-but-doesnt-match var against-val penv penv-out)])] 466 | [(== 'number? pred) 467 | (conde 468 | [(not-numbero against-val)] 469 | [(numbero against-val) 470 | (var-pattern-but-doesnt-match var against-val penv penv-out)])]))])) 471 | 472 | 473 | 474 | (define (quasi-pattern-matches quasi-pattern against-val penv penv-out) 475 | (conde 476 | [(== quasi-pattern against-val) 477 | (== penv penv-out) 478 | (literalo quasi-pattern)] 479 | [(fresh (pattern) 480 | (== (list 'unquote pattern) quasi-pattern) 481 | (pattern-matches pattern against-val penv penv-out))] 482 | [(fresh (a d v1 v2 penv^) 483 | (== `(,a . ,d) quasi-pattern) 484 | (== `(,v1 . ,v2) against-val) 485 | (=/= 'unquote a) 486 | (quasi-pattern-matches a v1 penv penv^) 487 | (quasi-pattern-matches d v2 penv^ penv-out))])) 488 | 489 | (define (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out) 490 | (conde 491 | [(=/= quasi-pattern against-val) 492 | (== penv penv-out) 493 | (literalo quasi-pattern)] 494 | [(fresh (pattern) 495 | (== (list 'unquote pattern) quasi-pattern) 496 | (pattern-but-doesnt-match pattern against-val penv penv-out))] 497 | [(fresh (a d) 498 | (== `(,a . ,d) quasi-pattern) 499 | (=/= 'unquote a) 500 | (conde 501 | [(== penv penv-out) 502 | (literalo against-val)] 503 | [(fresh (v1 v2 penv^) 504 | (== `(,v1 . ,v2) against-val) 505 | (conde 506 | [(quasi-pattern-but-doesnt-match a v1 penv penv^)] 507 | [(quasi-pattern-matches a v1 penv penv^) 508 | (quasi-pattern-but-doesnt-match d v2 penv^ penv-out)]))]))])) 509 | -------------------------------------------------------------------------------- /interp-with-variadic-lambda-and-match.scm: -------------------------------------------------------------------------------- 1 | ;; TODO 2 | ;; 3 | ;; * add quasiquote/unquote so we can easily and efficiently write 4 | ;; 'lambda' and 'fold' as macros. 5 | 6 | (load "mk/mk.scm") 7 | 8 | ;; supports variadic lambda: (lambda x x) 9 | 10 | 11 | ;; letrec is based on Dan Friedman's code, using the "half-closure" 12 | ;; approach from Reynold's definitional interpreters 13 | 14 | (define empty-env '()) 15 | 16 | (define lookupo 17 | (lambda (x env t) 18 | (conde 19 | ((fresh (y v rest) 20 | (== `(ext-env ,y ,v ,rest) env) 21 | (conde 22 | ((== y x) (== v t)) 23 | ((=/= y x) (lookupo x rest t))))) 24 | 25 | ((fresh (defs rest) 26 | (== `(ext-rec ,defs ,rest) env) 27 | (lookup-ext-reco x defs env rest t))) 28 | 29 | ))) 30 | 31 | (define lookup-ext-reco 32 | (lambda (x defs env rest t) 33 | (fresh (y lam-exp others) 34 | (conde 35 | ((== '() defs) (lookupo x rest t)) 36 | ((== `((,y ,lam-exp) . ,others) defs) 37 | (conde 38 | ((== y x) (== `(closure ,lam-exp ,env) t)) 39 | ((=/= y x) (lookup-ext-reco x others env rest t)))))))) 40 | 41 | (define not-in-envo 42 | (lambda (x env) 43 | (conde 44 | ((== empty-env env)) 45 | ((fresh (y v rest) 46 | (== `(ext-env ,y ,v ,rest) env) 47 | (=/= y x) 48 | (not-in-envo x rest))) 49 | 50 | ((fresh (defs rest) 51 | (== `(ext-rec ,defs ,rest) env) 52 | (not-in-defso x defs) 53 | (not-in-envo x rest))) 54 | 55 | ))) 56 | 57 | (define not-in-defso 58 | (lambda (x defs) 59 | (conde 60 | ((== '() defs)) 61 | ((fresh (y lam-exp others) 62 | (== `((,y ,lam-exp) . ,others) defs) 63 | (=/= y x) 64 | (not-in-defso x others)))))) 65 | 66 | (define eval-listo 67 | (lambda (exp env val) 68 | (conde 69 | ((== '() exp) 70 | (== '() val)) 71 | ((fresh (a d v-a v-d) 72 | (== `(,a . ,d) exp) 73 | (== `(,v-a . ,v-d) val) 74 | (eval-expo a env v-a) 75 | (eval-listo d env v-d)))))) 76 | 77 | ;; need to make sure lambdas are well formed. 78 | ;; grammar constraints would be useful here!!! 79 | (define list-of-symbolso 80 | (lambda (los) 81 | (conde 82 | ((== '() los)) 83 | ((fresh (a d) 84 | (== `(,a . ,d) los) 85 | (symbolo a) 86 | (list-of-symbolso d)))))) 87 | 88 | 89 | (define listo 90 | (lambda (ls) 91 | (conde 92 | ((== '() ls)) 93 | ((fresh (a d) 94 | (== `(,a . ,d) ls) 95 | (listo d)))))) 96 | 97 | (define evalo 98 | (lambda (exp val) 99 | (eval-expo exp empty-env val))) 100 | 101 | (define eval-expo 102 | (lambda (exp env val) 103 | (conde 104 | 105 | ((== `(quote ,val) exp) 106 | (absento 'closure val) 107 | (not-in-envo 'quote env)) 108 | 109 | ((numbero exp) (== exp val)) 110 | 111 | ((symbolo exp) (lookupo exp env val)) 112 | 113 | ;; should possibly combine these lambda clauses, application clauses, apply clauses, and letrec clauses 114 | 115 | ((fresh (x body) 116 | (== `(lambda ,x ,body) exp) 117 | (== `(closure (lambda ,x ,body) ,env) val) 118 | (symbolo x) 119 | (not-in-envo 'lambda env))) 120 | 121 | ((fresh (x* body) 122 | (== `(lambda ,x* ,body) exp) 123 | (== `(closure (lambda ,x* ,body) ,env) val) 124 | (list-of-symbolso x*) 125 | (not-in-envo 'lambda env))) 126 | 127 | ((fresh (a*) 128 | (== `(list . ,a*) exp) 129 | (not-in-envo 'list env) 130 | (eval-listo a* env val))) 131 | 132 | ((fresh (against-expr against-val clause clauses) 133 | (== `(match ,against-expr ,clause . ,clauses) exp) 134 | (not-in-envo 'match env) 135 | (eval-expo against-expr env against-val) 136 | (match-clauses against-val `(,clause . ,clauses) env val))) 137 | 138 | ((fresh (rator x rands body env^ a* res) 139 | (== `(,rator . ,rands) exp) 140 | (symbolo x) 141 | (== `(ext-env ,x ,a* ,env^) res) 142 | (eval-expo rator env `(closure (lambda ,x ,body) ,env^)) 143 | 144 | (eval-expo body res val) ;; perfect example of two serious 145 | ;; calls in which it isn't clear 146 | ;; which one should come first 147 | (eval-listo rands env a*))) 148 | 149 | ((fresh (rator x* rands body env^ a* res) 150 | (== `(,rator . ,rands) exp) 151 | (eval-expo rator env `(closure (lambda ,x* ,body) ,env^)) 152 | (eval-listo rands env a*) 153 | (ext-env*o x* a* env^ res) 154 | (eval-expo body res val))) 155 | 156 | ((fresh (p-name x body letrec-body) 157 | (== `(letrec ((,p-name (lambda ,x ,body))) ;; single-function variadic letrec version 158 | ,letrec-body) 159 | exp) 160 | (symbolo x) 161 | (not-in-envo 'letrec env) 162 | (eval-expo letrec-body 163 | `(ext-rec ((,p-name (lambda ,x ,body))) ,env) 164 | val))) 165 | 166 | ((fresh (p-name x* body letrec-body) 167 | (== `(letrec ((,p-name (lambda ,x* ,body))) ;; single-function multiple-argument letrec version 168 | ,letrec-body) 169 | exp) 170 | (list-of-symbolso x*) 171 | (not-in-envo 'letrec env) 172 | (eval-expo letrec-body 173 | `(ext-rec ((,p-name (lambda ,x* ,body))) ,env) 174 | val))) 175 | 176 | ;;; don't comment this out accidentally!!! 177 | ((prim-expo exp env val)) 178 | 179 | 180 | ;; apply for variadic procedure 181 | ((fresh (e e* x body env^ a* res) 182 | (== `(apply ,e ,e*) exp) 183 | (not-in-envo 'apply env) 184 | (symbolo x) 185 | (== `(ext-env ,x ,a* ,env^) res) 186 | (eval-expo e env `(closure (lambda ,x ,body) ,env^)) 187 | (eval-expo e* env a*) 188 | (listo a*) 189 | (eval-expo body res val))) 190 | 191 | ;; apply for mult-argument procedure 192 | ((fresh (e e* x x* body env^ a* res) 193 | (== `(apply ,e ,e*) exp) 194 | (not-in-envo 'apply env) 195 | (symbolo x) 196 | (ext-env*o `(,x . ,x*) a* env^ res) 197 | (eval-expo e env `(closure (lambda (,x . ,x*) ,body) ,env^)) 198 | (eval-expo e* env a*) 199 | (listo a*) 200 | (eval-expo body res val))) 201 | 202 | ))) 203 | 204 | (define ext-env*o 205 | (lambda (x* a* env out) 206 | (conde 207 | ((== '() x*) (== '() a*) (== env out)) 208 | ((fresh (x a dx* da* env2) 209 | (== `(,x . ,dx*) x*) 210 | (== `(,a . ,da*) a*) 211 | (== `(ext-env ,x ,a ,env) env2) 212 | (symbolo x) 213 | (ext-env*o dx* da* env2 out)))))) 214 | 215 | (define prim-expo 216 | (lambda (exp env val) 217 | (conde 218 | ((boolean-primo exp env val)) 219 | ((null?-primo exp env val)) 220 | ((symbol?-primo exp env val)) 221 | ((not-primo exp env val)) 222 | ((car-primo exp env val)) 223 | ((cdr-primo exp env val)) 224 | ((cons-primo exp env val)) 225 | ((equal?-primo exp env val)) 226 | ((if-primo exp env val))))) 227 | 228 | (define boolean-primo 229 | (lambda (exp env val) 230 | (conde 231 | ((== #t exp) (== #t val)) 232 | ((== #f exp) (== #f val))))) 233 | 234 | (define equal?-primo 235 | (lambda (exp env val) 236 | (fresh (e1 e2 v1 v2) 237 | (== `(equal? ,e1 ,e2) exp) 238 | (conde 239 | ((== v1 v2) (== #t val)) 240 | ((=/= v1 v2) (== #f val))) 241 | (not-in-envo 'equal? env) 242 | (eval-expo e1 env v1) 243 | (eval-expo e2 env v2)))) 244 | 245 | (define cons-primo 246 | (lambda (exp env val) 247 | (fresh (a d v-a v-d) 248 | (== `(cons ,a ,d) exp) 249 | (== `(,v-a . ,v-d) val) 250 | (not-in-envo 'cons env) 251 | (eval-expo a env v-a) 252 | (eval-expo d env v-d)))) 253 | 254 | (define car-primo 255 | (lambda (exp env val) 256 | (fresh (p a d) 257 | (== `(car ,p) exp) 258 | (== a val) 259 | (=/= 'closure a) 260 | (not-in-envo 'car env) 261 | (eval-expo p env `(,a . ,d))))) 262 | 263 | (define cdr-primo 264 | (lambda (exp env val) 265 | (fresh (p a d) 266 | (== `(cdr ,p) exp) 267 | (== d val) 268 | (=/= 'closure a) 269 | (not-in-envo 'cdr env) 270 | (eval-expo p env `(,a . ,d))))) 271 | 272 | (define not-primo 273 | (lambda (exp env val) 274 | (fresh (e b) 275 | (== `(not ,e) exp) 276 | (conde 277 | ((=/= #f b) (== #f val)) 278 | ((== #f b) (== #t val))) 279 | (not-in-envo 'not env) 280 | (eval-expo e env b)))) 281 | 282 | (define symbol?-primo 283 | (lambda (exp env val) 284 | (fresh (e v) 285 | (== `(symbol? ,e) exp) 286 | (conde 287 | ((symbolo v) (== #t val)) 288 | ((numbero v) (== #f val)) 289 | ((fresh (a d) 290 | (== `(,a . ,d) v) 291 | (== #f val)))) 292 | (not-in-envo 'symbol? env) 293 | (eval-expo e env v)))) 294 | 295 | (define null?-primo 296 | (lambda (exp env val) 297 | (fresh (e v) 298 | (== `(null? ,e) exp) 299 | (conde 300 | ((== '() v) (== #t val)) 301 | ((=/= '() v) (== #f val))) 302 | (not-in-envo 'null? env) 303 | (eval-expo e env v)))) 304 | 305 | (define if-primo 306 | (lambda (exp env val) 307 | (fresh (e1 e2 e3 t) 308 | (== `(if ,e1 ,e2 ,e3) exp) 309 | (not-in-envo 'if env) 310 | (eval-expo e1 env t) 311 | (conde 312 | ((=/= #f t) (eval-expo e2 env val)) 313 | ((== #f t) (eval-expo e3 env val)))))) 314 | 315 | 316 | 317 | ;; match-related code 318 | 319 | ;; really should be a constraint built into miniKanren 320 | (define not-symbolo 321 | (lambda (t) 322 | (conde 323 | [(== #f t)] 324 | [(== #t t)] 325 | [(numbero t)] 326 | [(fresh (a d) 327 | (== `(,a . ,d) t))]))) 328 | 329 | (define not-numbero 330 | (lambda (t) 331 | (conde 332 | [(== #f t)] 333 | [(== #t t)] 334 | [(symbolo t)] 335 | [(fresh (a d) 336 | (== `(,a . ,d) t))]))) 337 | 338 | (define self-eval-literalo 339 | (lambda (t) 340 | (conde 341 | [(numbero t)] 342 | [(booleano t)]))) 343 | 344 | (define literalo 345 | (lambda (t) 346 | (conde 347 | [(numbero t)] 348 | [(symbolo t)] 349 | [(booleano t)] 350 | [(== '() t)]))) 351 | 352 | (define booleano 353 | (lambda (t) 354 | (conde 355 | [(== #f t)] 356 | [(== #t t)]))) 357 | 358 | 359 | (define (regular-env-appendo env1 env2 env-out) 360 | (conde 361 | [(== empty-env env1) (== env2 env-out)] 362 | [(fresh (y v rest res) 363 | (== `(ext-env ,y ,v ,rest) env1) 364 | (== `(ext-env ,y ,v ,res) env-out) 365 | (regular-env-appendo rest env2 res))])) 366 | 367 | 368 | (define (match-clauses against-val clauses env val) 369 | (fresh (top-pattern result-expr d penv) 370 | (== `((,top-pattern ,result-expr) . ,d) clauses) 371 | (conde 372 | [(fresh (env^) 373 | (top-pattern-matches top-pattern against-val '() penv) 374 | (regular-env-appendo penv env env^) 375 | (eval-expo result-expr env^ val))] 376 | [(top-pattern-but-doesnt-match top-pattern against-val '() penv) 377 | (match-clauses against-val d env val)]))) 378 | 379 | 380 | 381 | (define (top-pattern-matches top-pattern against-val penv penv-out) 382 | (conde 383 | [(self-eval-literalo top-pattern) (== top-pattern against-val) (== penv penv-out)] 384 | [(pattern-matches top-pattern against-val penv penv-out)] 385 | [(fresh (quasi-pattern) 386 | (== (list 'quasiquote quasi-pattern) top-pattern) 387 | (quasi-pattern-matches quasi-pattern against-val penv penv-out))])) 388 | 389 | (define (top-pattern-but-doesnt-match top-pattern against-val penv penv-out) 390 | (conde 391 | [(self-eval-literalo top-pattern) (=/= top-pattern against-val) (== penv penv-out)] 392 | [(pattern-but-doesnt-match top-pattern against-val penv penv-out)] 393 | [(fresh (quasi-pattern) 394 | (== (list 'quasiquote quasi-pattern) top-pattern) 395 | (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out))])) 396 | 397 | 398 | (define (var-pattern-matches var against-val penv penv-out) 399 | (fresh (val) 400 | (symbolo var) 401 | (conde 402 | [(== against-val val) 403 | (== penv penv-out) 404 | (lookupo var penv val)] 405 | [(== `(ext-env ,var ,against-val ,penv) penv-out) 406 | (not-in-envo var penv)]))) 407 | 408 | (define (var-pattern-but-doesnt-match var against-val penv penv-out) 409 | (fresh (val) 410 | (symbolo var) 411 | (=/= against-val val) 412 | (== penv penv-out) 413 | (lookupo var penv val))) 414 | 415 | 416 | 417 | (define (pattern-matches pattern against-val penv penv-out) 418 | (conde 419 | [(var-pattern-matches pattern against-val penv penv-out)] 420 | [(fresh (var pred val) 421 | (== `(? ,pred ,var) pattern) 422 | (conde 423 | [(== 'symbol? pred) 424 | (symbolo against-val)] 425 | [(== 'number? pred) 426 | (numbero against-val)]) 427 | (var-pattern-matches var against-val penv penv-out))])) 428 | 429 | (define (pattern-but-doesnt-match pattern against-val penv penv-out) 430 | (conde 431 | [(var-pattern-but-doesnt-match pattern against-val penv penv-out)] 432 | [(fresh (var pred val) 433 | (== `(? ,pred ,var) pattern) 434 | (== penv penv-out) 435 | (symbolo var) 436 | (conde 437 | [(== 'symbol? pred) 438 | (conde 439 | [(not-symbolo against-val)] 440 | [(symbolo against-val) 441 | (var-pattern-but-doesnt-match var against-val penv penv-out)])] 442 | [(== 'number? pred) 443 | (conde 444 | [(not-numbero against-val)] 445 | [(numbero against-val) 446 | (var-pattern-but-doesnt-match var against-val penv penv-out)])]))])) 447 | 448 | 449 | 450 | (define (quasi-pattern-matches quasi-pattern against-val penv penv-out) 451 | (conde 452 | [(== quasi-pattern against-val) 453 | (== penv penv-out) 454 | (literalo quasi-pattern)] 455 | [(fresh (pattern) 456 | (== (list 'unquote pattern) quasi-pattern) 457 | (pattern-matches pattern against-val penv penv-out))] 458 | [(fresh (a d v1 v2 penv^) 459 | (== `(,a . ,d) quasi-pattern) 460 | (== `(,v1 . ,v2) against-val) 461 | (=/= 'unquote a) 462 | (quasi-pattern-matches a v1 penv penv^) 463 | (quasi-pattern-matches d v2 penv^ penv-out))])) 464 | 465 | (define (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out) 466 | (conde 467 | [(=/= quasi-pattern against-val) 468 | (== penv penv-out) 469 | (literalo quasi-pattern)] 470 | [(fresh (pattern) 471 | (== (list 'unquote pattern) quasi-pattern) 472 | (pattern-but-doesnt-match pattern against-val penv penv-out))] 473 | [(fresh (a d) 474 | (== `(,a . ,d) quasi-pattern) 475 | (=/= 'unquote a) 476 | (conde 477 | [(== penv penv-out) 478 | (literalo against-val)] 479 | [(fresh (v1 v2 penv^) 480 | (== `(,v1 . ,v2) against-val) 481 | (conde 482 | [(quasi-pattern-but-doesnt-match a v1 penv penv^)] 483 | [(quasi-pattern-matches a v1 penv penv^) 484 | (quasi-pattern-but-doesnt-match d v2 penv^ penv-out)]))]))])) 485 | -------------------------------------------------------------------------------- /interp-with-variadic-lambda-and-or-and-match.scm: -------------------------------------------------------------------------------- 1 | ;; TODO 2 | ;; 3 | ;; * add quasiquote/unquote so we can easily and efficiently write 4 | ;; 'lambda' and 'fold' as macros. 5 | 6 | (load "mk/mk.scm") 7 | 8 | ;; supports variadic lambda: (lambda x x) 9 | 10 | 11 | ;; letrec is based on Dan Friedman's code, using the "half-closure" 12 | ;; approach from Reynold's definitional interpreters 13 | 14 | (define empty-env '()) 15 | 16 | (define lookupo 17 | (lambda (x env t) 18 | (conde 19 | ((fresh (y v rest) 20 | (== `(ext-env ,y ,v ,rest) env) 21 | (conde 22 | ((== y x) (== v t)) 23 | ((=/= y x) (lookupo x rest t))))) 24 | 25 | ((fresh (defs rest) 26 | (== `(ext-rec ,defs ,rest) env) 27 | (lookup-ext-reco x defs env rest t))) 28 | 29 | ))) 30 | 31 | (define lookup-ext-reco 32 | (lambda (x defs env rest t) 33 | (fresh (y lam-exp others) 34 | (conde 35 | ((== '() defs) (lookupo x rest t)) 36 | ((== `((,y ,lam-exp) . ,others) defs) 37 | (conde 38 | ((== y x) (== `(closure ,lam-exp ,env) t)) 39 | ((=/= y x) (lookup-ext-reco x others env rest t)))))))) 40 | 41 | (define not-in-envo 42 | (lambda (x env) 43 | (conde 44 | ((== empty-env env)) 45 | ((fresh (y v rest) 46 | (== `(ext-env ,y ,v ,rest) env) 47 | (=/= y x) 48 | (not-in-envo x rest))) 49 | 50 | ((fresh (defs rest) 51 | (== `(ext-rec ,defs ,rest) env) 52 | (not-in-defso x defs) 53 | (not-in-envo x rest))) 54 | 55 | ))) 56 | 57 | (define not-in-defso 58 | (lambda (x defs) 59 | (conde 60 | ((== '() defs)) 61 | ((fresh (y lam-exp others) 62 | (== `((,y ,lam-exp) . ,others) defs) 63 | (=/= y x) 64 | (not-in-defso x others)))))) 65 | 66 | (define eval-listo 67 | (lambda (exp env val) 68 | (conde 69 | ((== '() exp) 70 | (== '() val)) 71 | ((fresh (a d v-a v-d) 72 | (== `(,a . ,d) exp) 73 | (== `(,v-a . ,v-d) val) 74 | (eval-expo a env v-a) 75 | (eval-listo d env v-d)))))) 76 | 77 | ;; need to make sure lambdas are well formed. 78 | ;; grammar constraints would be useful here!!! 79 | (define list-of-symbolso 80 | (lambda (los) 81 | (conde 82 | ((== '() los)) 83 | ((fresh (a d) 84 | (== `(,a . ,d) los) 85 | (symbolo a) 86 | (list-of-symbolso d)))))) 87 | 88 | 89 | (define listo 90 | (lambda (ls) 91 | (conde 92 | ((== '() ls)) 93 | ((fresh (a d) 94 | (== `(,a . ,d) ls) 95 | (listo d)))))) 96 | 97 | (define evalo 98 | (lambda (exp val) 99 | (eval-expo exp empty-env val))) 100 | 101 | (define eval-expo 102 | (lambda (exp env val) 103 | (conde 104 | 105 | ((== `(quote ,val) exp) 106 | (absento 'closure val) 107 | (not-in-envo 'quote env)) 108 | 109 | ((numbero exp) (== exp val)) 110 | 111 | ((symbolo exp) (lookupo exp env val)) 112 | 113 | ;; should possibly combine these lambda clauses, application clauses, apply clauses, and letrec clauses 114 | 115 | ((fresh (x body) 116 | (== `(lambda ,x ,body) exp) 117 | (== `(closure (lambda ,x ,body) ,env) val) 118 | (symbolo x) 119 | (not-in-envo 'lambda env))) 120 | 121 | ((fresh (x* body) 122 | (== `(lambda ,x* ,body) exp) 123 | (== `(closure (lambda ,x* ,body) ,env) val) 124 | (list-of-symbolso x*) 125 | (not-in-envo 'lambda env))) 126 | 127 | ((fresh (a*) 128 | (== `(list . ,a*) exp) 129 | (not-in-envo 'list env) 130 | (eval-listo a* env val))) 131 | 132 | ((fresh (against-expr against-val clause clauses) 133 | (== `(match ,against-expr ,clause . ,clauses) exp) 134 | (not-in-envo 'match env) 135 | (eval-expo against-expr env against-val) 136 | (match-clauses against-val `(,clause . ,clauses) env val))) 137 | 138 | ((fresh (rator x rands body env^ a* res) 139 | (== `(,rator . ,rands) exp) 140 | (symbolo x) 141 | (== `(ext-env ,x ,a* ,env^) res) 142 | (eval-expo rator env `(closure (lambda ,x ,body) ,env^)) 143 | 144 | (eval-expo body res val) ;; perfect example of two serious 145 | ;; calls in which it isn't clear 146 | ;; which one should come first 147 | (eval-listo rands env a*))) 148 | 149 | ((fresh (rator x* rands body env^ a* res) 150 | (== `(,rator . ,rands) exp) 151 | (eval-expo rator env `(closure (lambda ,x* ,body) ,env^)) 152 | (eval-listo rands env a*) 153 | (ext-env*o x* a* env^ res) 154 | (eval-expo body res val))) 155 | 156 | ((fresh (p-name x body letrec-body) 157 | (== `(letrec ((,p-name (lambda ,x ,body))) ;; single-function variadic letrec version 158 | ,letrec-body) 159 | exp) 160 | (symbolo x) 161 | (not-in-envo 'letrec env) 162 | (eval-expo letrec-body 163 | `(ext-rec ((,p-name (lambda ,x ,body))) ,env) 164 | val))) 165 | 166 | ((fresh (p-name x* body letrec-body) 167 | (== `(letrec ((,p-name (lambda ,x* ,body))) ;; single-function multiple-argument letrec version 168 | ,letrec-body) 169 | exp) 170 | (list-of-symbolso x*) 171 | (not-in-envo 'letrec env) 172 | (eval-expo letrec-body 173 | `(ext-rec ((,p-name (lambda ,x* ,body))) ,env) 174 | val))) 175 | 176 | ;;; don't comment this out accidentally!!! 177 | ((prim-expo exp env val)) 178 | 179 | 180 | ;; apply for variadic procedure 181 | ((fresh (e e* x body env^ a* res) 182 | (== `(apply ,e ,e*) exp) 183 | (not-in-envo 'apply env) 184 | (symbolo x) 185 | (== `(ext-env ,x ,a* ,env^) res) 186 | (eval-expo e env `(closure (lambda ,x ,body) ,env^)) 187 | (eval-expo e* env a*) 188 | (listo a*) 189 | (eval-expo body res val))) 190 | 191 | ;; apply for mult-argument procedure 192 | ((fresh (e e* x x* body env^ a* res) 193 | (== `(apply ,e ,e*) exp) 194 | (not-in-envo 'apply env) 195 | (symbolo x) 196 | (ext-env*o `(,x . ,x*) a* env^ res) 197 | (eval-expo e env `(closure (lambda (,x . ,x*) ,body) ,env^)) 198 | (eval-expo e* env a*) 199 | (listo a*) 200 | (eval-expo body res val))) 201 | 202 | ))) 203 | 204 | (define ext-env*o 205 | (lambda (x* a* env out) 206 | (conde 207 | ((== '() x*) (== '() a*) (== env out)) 208 | ((fresh (x a dx* da* env2) 209 | (== `(,x . ,dx*) x*) 210 | (== `(,a . ,da*) a*) 211 | (== `(ext-env ,x ,a ,env) env2) 212 | (symbolo x) 213 | (ext-env*o dx* da* env2 out)))))) 214 | 215 | (define prim-expo 216 | (lambda (exp env val) 217 | (conde 218 | ((boolean-primo exp env val)) 219 | ((and-primo exp env val)) 220 | ((or-primo exp env val)) 221 | ((null?-primo exp env val)) 222 | ((symbol?-primo exp env val)) 223 | ((not-primo exp env val)) 224 | ((car-primo exp env val)) 225 | ((cdr-primo exp env val)) 226 | ((cons-primo exp env val)) 227 | ((equal?-primo exp env val)) 228 | ((if-primo exp env val))))) 229 | 230 | (define boolean-primo 231 | (lambda (exp env val) 232 | (conde 233 | ((== #t exp) (== #t val)) 234 | ((== #f exp) (== #f val))))) 235 | 236 | (define and-primo 237 | (lambda (exp env val) 238 | (fresh (e*) 239 | (== `(and . ,e*) exp) 240 | (not-in-envo 'and env) 241 | (ando e* env val)))) 242 | 243 | (define ando 244 | (lambda (e* env val) 245 | (conde 246 | ((== '() e*) (== #t val)) 247 | ((fresh (e) 248 | (== `(,e) e*) 249 | (eval-expo e env val))) 250 | ((fresh (e1 e2 e-rest v) 251 | (== `(,e1 ,e2 . ,e-rest) e*) 252 | (conde 253 | ((== #f v) 254 | (== #f val) 255 | (eval-expo e1 env v)) 256 | ((=/= #f v) 257 | (eval-expo e1 env v) 258 | (ando `(,e2 . ,e-rest) env val)))))))) 259 | 260 | (define or-primo 261 | (lambda (exp env val) 262 | (fresh (e*) 263 | (== `(or . ,e*) exp) 264 | (not-in-envo 'or env) 265 | (oro e* env val)))) 266 | 267 | (define oro 268 | (lambda (e* env val) 269 | (conde 270 | ((== '() e*) (== #f val)) 271 | ((fresh (e) 272 | (== `(,e) e*) 273 | (eval-expo e env val))) 274 | ((fresh (e1 e2 e-rest v) 275 | (== `(,e1 ,e2 . ,e-rest) e*) 276 | (conde 277 | ((=/= #f v) 278 | (== v val) 279 | (eval-expo e1 env v)) 280 | ((== #f v) 281 | (eval-expo e1 env v) 282 | (oro `(,e2 . ,e-rest) env val)))))))) 283 | 284 | 285 | (define equal?-primo 286 | (lambda (exp env val) 287 | (fresh (e1 e2 v1 v2) 288 | (== `(equal? ,e1 ,e2) exp) 289 | (conde 290 | ((== v1 v2) (== #t val)) 291 | ((=/= v1 v2) (== #f val))) 292 | (not-in-envo 'equal? env) 293 | (eval-expo e1 env v1) 294 | (eval-expo e2 env v2)))) 295 | 296 | (define cons-primo 297 | (lambda (exp env val) 298 | (fresh (a d v-a v-d) 299 | (== `(cons ,a ,d) exp) 300 | (== `(,v-a . ,v-d) val) 301 | (not-in-envo 'cons env) 302 | (eval-expo a env v-a) 303 | (eval-expo d env v-d)))) 304 | 305 | (define car-primo 306 | (lambda (exp env val) 307 | (fresh (p a d) 308 | (== `(car ,p) exp) 309 | (== a val) 310 | (=/= 'closure a) 311 | (not-in-envo 'car env) 312 | (eval-expo p env `(,a . ,d))))) 313 | 314 | (define cdr-primo 315 | (lambda (exp env val) 316 | (fresh (p a d) 317 | (== `(cdr ,p) exp) 318 | (== d val) 319 | (=/= 'closure a) 320 | (not-in-envo 'cdr env) 321 | (eval-expo p env `(,a . ,d))))) 322 | 323 | (define not-primo 324 | (lambda (exp env val) 325 | (fresh (e b) 326 | (== `(not ,e) exp) 327 | (conde 328 | ((=/= #f b) (== #f val)) 329 | ((== #f b) (== #t val))) 330 | (not-in-envo 'not env) 331 | (eval-expo e env b)))) 332 | 333 | (define symbol?-primo 334 | (lambda (exp env val) 335 | (fresh (e v) 336 | (== `(symbol? ,e) exp) 337 | (conde 338 | ((symbolo v) (== #t val)) 339 | ((numbero v) (== #f val)) 340 | ((fresh (a d) 341 | (== `(,a . ,d) v) 342 | (== #f val)))) 343 | (not-in-envo 'symbol? env) 344 | (eval-expo e env v)))) 345 | 346 | (define null?-primo 347 | (lambda (exp env val) 348 | (fresh (e v) 349 | (== `(null? ,e) exp) 350 | (conde 351 | ((== '() v) (== #t val)) 352 | ((=/= '() v) (== #f val))) 353 | (not-in-envo 'null? env) 354 | (eval-expo e env v)))) 355 | 356 | (define if-primo 357 | (lambda (exp env val) 358 | (fresh (e1 e2 e3 t) 359 | (== `(if ,e1 ,e2 ,e3) exp) 360 | (not-in-envo 'if env) 361 | (eval-expo e1 env t) 362 | (conde 363 | ((=/= #f t) (eval-expo e2 env val)) 364 | ((== #f t) (eval-expo e3 env val)))))) 365 | 366 | 367 | 368 | ;; match-related code 369 | 370 | ;; really should be a constraint built into miniKanren 371 | (define not-symbolo 372 | (lambda (t) 373 | (conde 374 | [(== #f t)] 375 | [(== #t t)] 376 | [(numbero t)] 377 | [(fresh (a d) 378 | (== `(,a . ,d) t))]))) 379 | 380 | (define not-numbero 381 | (lambda (t) 382 | (conde 383 | [(== #f t)] 384 | [(== #t t)] 385 | [(symbolo t)] 386 | [(fresh (a d) 387 | (== `(,a . ,d) t))]))) 388 | 389 | (define self-eval-literalo 390 | (lambda (t) 391 | (conde 392 | [(numbero t)] 393 | [(booleano t)]))) 394 | 395 | (define literalo 396 | (lambda (t) 397 | (conde 398 | [(numbero t)] 399 | [(symbolo t)] 400 | [(booleano t)] 401 | [(== '() t)]))) 402 | 403 | (define booleano 404 | (lambda (t) 405 | (conde 406 | [(== #f t)] 407 | [(== #t t)]))) 408 | 409 | 410 | (define (regular-env-appendo env1 env2 env-out) 411 | (conde 412 | [(== empty-env env1) (== env2 env-out)] 413 | [(fresh (y v rest res) 414 | (== `(ext-env ,y ,v ,rest) env1) 415 | (== `(ext-env ,y ,v ,res) env-out) 416 | (regular-env-appendo rest env2 res))])) 417 | 418 | 419 | (define (match-clauses against-val clauses env val) 420 | (fresh (top-pattern result-expr d penv) 421 | (== `((,top-pattern ,result-expr) . ,d) clauses) 422 | (conde 423 | [(fresh (env^) 424 | (top-pattern-matches top-pattern against-val '() penv) 425 | (regular-env-appendo penv env env^) 426 | (eval-expo result-expr env^ val))] 427 | [(top-pattern-but-doesnt-match top-pattern against-val '() penv) 428 | (match-clauses against-val d env val)]))) 429 | 430 | 431 | 432 | (define (top-pattern-matches top-pattern against-val penv penv-out) 433 | (conde 434 | [(self-eval-literalo top-pattern) (== top-pattern against-val) (== penv penv-out)] 435 | [(pattern-matches top-pattern against-val penv penv-out)] 436 | [(fresh (quasi-pattern) 437 | (== (list 'quasiquote quasi-pattern) top-pattern) 438 | (quasi-pattern-matches quasi-pattern against-val penv penv-out))])) 439 | 440 | (define (top-pattern-but-doesnt-match top-pattern against-val penv penv-out) 441 | (conde 442 | [(self-eval-literalo top-pattern) (=/= top-pattern against-val) (== penv penv-out)] 443 | [(pattern-but-doesnt-match top-pattern against-val penv penv-out)] 444 | [(fresh (quasi-pattern) 445 | (== (list 'quasiquote quasi-pattern) top-pattern) 446 | (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out))])) 447 | 448 | 449 | (define (var-pattern-matches var against-val penv penv-out) 450 | (fresh (val) 451 | (symbolo var) 452 | (conde 453 | [(== against-val val) 454 | (== penv penv-out) 455 | (lookupo var penv val)] 456 | [(== `(ext-env ,var ,against-val ,penv) penv-out) 457 | (not-in-envo var penv)]))) 458 | 459 | (define (var-pattern-but-doesnt-match var against-val penv penv-out) 460 | (fresh (val) 461 | (symbolo var) 462 | (=/= against-val val) 463 | (== penv penv-out) 464 | (lookupo var penv val))) 465 | 466 | 467 | 468 | (define (pattern-matches pattern against-val penv penv-out) 469 | (conde 470 | [(var-pattern-matches pattern against-val penv penv-out)] 471 | [(fresh (var pred val) 472 | (== `(? ,pred ,var) pattern) 473 | (conde 474 | [(== 'symbol? pred) 475 | (symbolo against-val)] 476 | [(== 'number? pred) 477 | (numbero against-val)]) 478 | (var-pattern-matches var against-val penv penv-out))])) 479 | 480 | (define (pattern-but-doesnt-match pattern against-val penv penv-out) 481 | (conde 482 | [(var-pattern-but-doesnt-match pattern against-val penv penv-out)] 483 | [(fresh (var pred val) 484 | (== `(? ,pred ,var) pattern) 485 | (== penv penv-out) 486 | (symbolo var) 487 | (conde 488 | [(== 'symbol? pred) 489 | (conde 490 | [(not-symbolo against-val)] 491 | [(symbolo against-val) 492 | (var-pattern-but-doesnt-match var against-val penv penv-out)])] 493 | [(== 'number? pred) 494 | (conde 495 | [(not-numbero against-val)] 496 | [(numbero against-val) 497 | (var-pattern-but-doesnt-match var against-val penv penv-out)])]))])) 498 | 499 | 500 | 501 | (define (quasi-pattern-matches quasi-pattern against-val penv penv-out) 502 | (conde 503 | [(== quasi-pattern against-val) 504 | (== penv penv-out) 505 | (literalo quasi-pattern)] 506 | [(fresh (pattern) 507 | (== (list 'unquote pattern) quasi-pattern) 508 | (pattern-matches pattern against-val penv penv-out))] 509 | [(fresh (a d v1 v2 penv^) 510 | (== `(,a . ,d) quasi-pattern) 511 | (== `(,v1 . ,v2) against-val) 512 | (=/= 'unquote a) 513 | (quasi-pattern-matches a v1 penv penv^) 514 | (quasi-pattern-matches d v2 penv^ penv-out))])) 515 | 516 | (define (quasi-pattern-but-doesnt-match quasi-pattern against-val penv penv-out) 517 | (conde 518 | [(=/= quasi-pattern against-val) 519 | (== penv penv-out) 520 | (literalo quasi-pattern)] 521 | [(fresh (pattern) 522 | (== (list 'unquote pattern) quasi-pattern) 523 | (pattern-but-doesnt-match pattern against-val penv penv-out))] 524 | [(fresh (a d) 525 | (== `(,a . ,d) quasi-pattern) 526 | (=/= 'unquote a) 527 | (conde 528 | [(== penv penv-out) 529 | (literalo against-val)] 530 | [(fresh (v1 v2 penv^) 531 | (== `(,v1 . ,v2) against-val) 532 | (conde 533 | [(quasi-pattern-but-doesnt-match a v1 penv penv^)] 534 | [(quasi-pattern-matches a v1 penv penv^) 535 | (quasi-pattern-but-doesnt-match d v2 penv^ penv-out)]))]))])) 536 | -------------------------------------------------------------------------------- /match-tests.scm: -------------------------------------------------------------------------------- 1 | (load "interp-match.scm") 2 | (load "mk/test-check.scm") 3 | 4 | 5 | (test "env-match-1" 6 | (run* (q) 7 | (eval-expo 8 | '((lambda (w) 9 | (match '(lambda (y) (y z)) 10 | [`(lambda (,x) ,body) (cons w body)])) 11 | 6) 12 | '() 13 | q)) 14 | '((6 y z))) 15 | 16 | 17 | 18 | (test "match-0" 19 | (run* (q) (eval-expo '(match 5) '() q)) 20 | '()) 21 | 22 | (test "match-1a" 23 | (run* (q) (eval-expo '(match 5 [5 6]) '() q)) 24 | '(6)) 25 | 26 | (test "match-1b" 27 | (run* (q) (eval-expo '(match 5 [x 6]) '() q)) 28 | '(6)) 29 | 30 | (test "match-1c" 31 | (run* (q) (eval-expo '(match 5 [x x]) '() q)) 32 | '(5)) 33 | 34 | (test "match-1d" 35 | (run* (q) (eval-expo '(match 5 [5 6] [7 8]) '() q)) 36 | '(6)) 37 | 38 | (test "match-1e" 39 | (run* (q) (eval-expo '(match 5 [x 6] [y 7]) '() q)) 40 | '(6)) 41 | 42 | (test "match-1f" 43 | (run* (q) (eval-expo '(match 5 [x 6] [x 7]) '() q)) 44 | '(6)) 45 | 46 | 47 | 48 | (test "match-2" 49 | (run* (q) (eval-expo '(match (cons 5 6) [`(,x . ,y) 7]) '() q)) 50 | '(7)) 51 | 52 | (test "match-3" 53 | (run* (q) (eval-expo '(match (cons 5 6) [`(,x . ,y) x]) '() q)) 54 | '(5)) 55 | 56 | (test "match-4" 57 | (run* (q) (eval-expo '(match (cons 5 6) [`(,x . ,y) y]) '() q)) 58 | '(6)) 59 | 60 | (test "match-5" 61 | (run* (q) (eval-expo '(match (cons 5 6) [7 8]) '() q)) 62 | '()) 63 | 64 | (test "match-6" 65 | (run* (q) (eval-expo '(match 4 [7 8]) '() q)) 66 | '()) 67 | 68 | (test "match-7" 69 | (run* (q) (eval-expo '(match '(lambda (y) (y z)) [`(lambda (,x) ,body) (cons x body)]) '() q)) 70 | '((y y z))) 71 | 72 | (test "match-8" 73 | (run* (q) (eval-expo '(match '((lambda (y) (y z)) 5) [`(,rator ,rand) (cons rator (cons rand '()))]) '() q)) 74 | '(((lambda (y) (y z)) 5))) 75 | 76 | (test "match-9" 77 | (run* (q) (eval-expo 78 | '(match '((lambda (y) (y z)) 5) 79 | [`(lambda (,x) ,body) (cons 'lambda-expr (cons x (cons body '())))] 80 | [`(,rator ,rand) (cons 'app-expr (cons rator (cons rand '())))]) 81 | '() 82 | q)) 83 | '((app-expr (lambda (y) (y z)) 5))) 84 | 85 | (test "match-10" 86 | (run* (q) (eval-expo 87 | '(match '(lambda (y) (y z)) 88 | [`(lambda (,x) ,body) (cons 'lambda-expr (cons x (cons body '())))] 89 | [`(,rator ,rand) (cons 'app-expr (cons rator (cons rand '())))]) 90 | '() 91 | q)) 92 | '((lambda-expr y (y z)))) 93 | 94 | (test "match-11" 95 | (run* (q) (eval-expo 96 | '(match '(5 6 7) 97 | [`(,x ,y ,z) (cons 'first (cons x (cons y (cons z '()))))] 98 | [`(,u ,v ,w) (cons 'second (cons u (cons v (cons w '()))))]) 99 | '() 100 | q)) 101 | '((first 5 6 7))) 102 | 103 | (test "match-12" 104 | (run* (q) (eval-expo 105 | '(match '(5 6 7) 106 | [`(,x ,y ,x) (cons 'first (cons x (cons y (cons x '()))))] 107 | [`(,u ,v ,w) (cons 'second (cons u (cons v (cons w '()))))]) 108 | '() 109 | q)) 110 | '((second 5 6 7))) 111 | 112 | (test "match-13" 113 | (run* (q) (eval-expo 114 | '(match '(5 6 7) 115 | [`(,x ,y ,x) (cons 'first (cons x (cons y (cons x '()))))] 116 | [`(,x ,y ,z) (cons 'second (cons x (cons y (cons z '()))))]) 117 | '() 118 | q)) 119 | '((second 5 6 7))) 120 | 121 | (test "match-14" 122 | (run* (q) (eval-expo 123 | '(match '(5 6 5) 124 | [`(,x ,y ,z) (cons 'first (cons x (cons y (cons z '()))))] 125 | [`(,u ,v ,w) (cons 'second (cons u (cons v (cons w '()))))]) 126 | '() 127 | q)) 128 | '((first 5 6 5))) 129 | 130 | (test "match-15" 131 | (run* (q) (eval-expo 132 | '(match '(5 6 5) 133 | [`(,x ,y ,x) (cons 'first (cons x (cons y (cons x '()))))] 134 | [`(,u ,v ,w) (cons 'second (cons u (cons v (cons w '()))))]) 135 | '() 136 | q)) 137 | '((first 5 6 5))) 138 | 139 | (test "match-16" 140 | (run* (q) (eval-expo 141 | '(match '(5 6 5) 142 | [`(,x ,y ,x) (cons 'first (cons x (cons y (cons x '()))))] 143 | [`(,x ,y ,z) (cons 'second (cons x (cons y (cons z '()))))]) 144 | '() 145 | q)) 146 | '((first 5 6 5))) 147 | 148 | 149 | (test "match-17" 150 | (run* (q) (eval-expo '(match '#t [#f 6] [#t 8]) '() q)) 151 | '(8)) 152 | 153 | 154 | 155 | ;; Racket-compatible 'symbol?' predicate syntax 156 | ;; 157 | ;; `(lambda (,(? symbol? x)) ,body) 158 | ;; 159 | (test "match-symbol-0a" 160 | (run* (q) (eval-expo 161 | '(match 'w 162 | [(? symbol? y) y]) 163 | '() 164 | q)) 165 | '(w)) 166 | 167 | (test "match-symbol-1" 168 | (run* (q) (eval-expo 169 | '(match '(lambda (y) (y z)) 170 | [`(lambda (,(? symbol? x)) ,body) (cons x body)]) 171 | '() 172 | q)) 173 | '((y y z))) 174 | 175 | (test "match-symbol-2" 176 | (run 1 (pat out) (eval-expo `(match ,pat [`(lambda (,(? symbol? x)) ,body) (cons x body)]) '() out)) 177 | '((('(lambda (_.0) _.1) 178 | (_.0 . _.1)) 179 | (=/= ((_.0 closure))) 180 | (sym _.0) 181 | (absento (closure _.1))))) 182 | 183 | (test "match-symbol-3" 184 | (run 3 (pat out) (eval-expo `(match ,pat [`(lambda (,(? symbol? x)) ,body) (cons x body)]) '() out)) 185 | '((('(lambda (_.0) _.1) (_.0 . _.1)) 186 | (=/= ((_.0 closure))) 187 | (sym _.0) 188 | (absento (closure _.1))) 189 | ((((lambda (_.0) '(lambda (_.1) _.2)) _.3) (_.1 . _.2)) 190 | (=/= ((_.0 quote)) ((_.1 closure))) 191 | (num _.3) 192 | (sym _.0 _.1) 193 | (absento (closure _.2))) 194 | ((((lambda (_.0) '(lambda (_.1) _.2)) #f) (_.1 . _.2)) 195 | (=/= ((_.0 quote)) ((_.1 closure))) 196 | (sym _.0 _.1) 197 | (absento (closure _.2))))) 198 | 199 | (test "match-symbol-4" 200 | (run 3 (body) (eval-expo `(match '(lambda (y) (y z)) [`(lambda (,(? symbol? x)) ,body) ,body]) '() '(y y z))) 201 | '('(y y z) 202 | (cons 'y body) 203 | (cons 'y '(y z)))) 204 | 205 | 206 | 207 | 208 | (test "match-1a-backwards" 209 | (run* (q) (eval-expo `(match 5 210 | [,q 6]) 211 | '() 212 | '6)) 213 | '(5 214 | `5 215 | (_.0 (sym _.0)) 216 | ((? number? _.0) (sym _.0)) 217 | (`,_.0 (sym _.0)) 218 | (`,(? number? _.0) (sym _.0)))) 219 | 220 | 221 | (test "match-1c-backwards" 222 | (run* (q) (eval-expo `(match 5 [,q x]) '() 5)) 223 | '(x 224 | (? number? x) 225 | `,x 226 | `,(? number? x))) 227 | 228 | (test "match-8-backwards-verify-a" 229 | (run* (q) 230 | (eval-expo 231 | '(match '((lambda (y) (y z)) 5) [`(,rator ,rand unquote _.0) (cons rator (cons rand '()))]) 232 | '() 233 | q)) 234 | '(((lambda (y) (y z)) 5))) 235 | 236 | (test "match-8-backwards-verify-b" 237 | (run* (q) 238 | (eval-expo 239 | '(match '((lambda (y) (y z)) 5) [`(,rator ,rand unquote _.0) (cons rator (cons rand '()))]) 240 | '() 241 | q)) 242 | '(((lambda (y) (y z)) 5))) 243 | 244 | (test "match-8-backwards-verify-c" 245 | (run* (q) 246 | (eval-expo 247 | '(match '((lambda (y) (y z)) 5) [`(,rator ,rand unquote foo) (cons rator (cons rand '()))]) 248 | '() 249 | q)) 250 | '(((lambda (y) (y z)) 5))) 251 | 252 | (test "match-8-backwards-verify-d" 253 | (run* (q) 254 | (eval-expo 255 | '(match '((lambda (y) (y z)) 5) [`(,rator ,rand . (unquote foo)) (cons rator (cons rand '()))]) 256 | '() 257 | q)) 258 | '(((lambda (y) (y z)) 5))) 259 | 260 | (test "match-8-backwards-verify-e" 261 | (run* (q) 262 | (eval-expo 263 | '(match '((lambda (y) (y z)) 5) [`(,rator ,rand . ,foo) (cons rator (cons rand '()))]) 264 | '() 265 | q)) 266 | '(((lambda (y) (y z)) 5))) 267 | 268 | 269 | 270 | (test "eval-expo-1" 271 | (run* (q) (eval-expo '5 '() q)) 272 | '(5)) 273 | 274 | (test "eval-expo-2" 275 | (run* (q) (eval-expo 'x '() q)) 276 | '()) 277 | 278 | (test "eval-expo-3" 279 | (run* (q) (eval-expo '(lambda (x) x) '() q)) 280 | '((closure x x ()))) 281 | 282 | (test "eval-expo-4" 283 | (run* (q) (eval-expo '((lambda (x) x) 5) '() q)) 284 | '(5)) 285 | 286 | (test "eval-expo-5" 287 | (run* (q) (eval-expo '((lambda (x) (lambda (y) x)) 5) '() q)) 288 | '((closure y x ((x . 5))))) 289 | 290 | 291 | 292 | (test "quine-1" 293 | (run 6 (q) (eval-expo q '() q)) 294 | '((_.0 (num _.0)) 295 | #f 296 | #t 297 | (((lambda (_.0) 298 | (cons _.0 (cons (cons 'quote (cons _.0 '())) '()))) 299 | '(lambda (_.0) 300 | (cons _.0 (cons (cons 'quote (cons _.0 '())) '())))) 301 | (=/= ((_.0 closure)) ((_.0 cons)) ((_.0 quote))) 302 | (sym _.0)) 303 | (((lambda (_.0) 304 | (cons _.0 305 | (cons (cons 'quote (cons _.0 '())) 306 | ((lambda (_.1) '()) _.2)))) 307 | '(lambda (_.0) 308 | (cons _.0 309 | (cons (cons 'quote (cons _.0 '())) 310 | ((lambda (_.1) '()) _.2))))) 311 | (=/= ((_.0 closure)) ((_.0 cons)) ((_.0 lambda)) 312 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 313 | (num _.2) (sym _.0 _.1)) 314 | (((lambda (_.0) 315 | (cons _.0 316 | (cons (cons 'quote (cons _.0 '())) 317 | ((lambda (_.1) '()) #f)))) 318 | '(lambda (_.0) 319 | (cons _.0 320 | (cons (cons 'quote (cons _.0 '())) 321 | ((lambda (_.1) '()) #f))))) 322 | (=/= ((_.0 closure)) ((_.0 cons)) ((_.0 lambda)) 323 | ((_.0 quote)) ((_.1 closure)) ((_.1 quote))) 324 | (sym _.0 _.1)))) 325 | 326 | (test "closure-generation" 327 | (run 10 (q) 328 | (eval-expo 329 | q 330 | '() 331 | '(closure x x ()))) 332 | '((lambda (x) x) 333 | ((match _.0 (_.0 (lambda (x) x)) . _.1) 334 | (num _.0)) 335 | (match #f (#f (lambda (x) x)) . _.0) 336 | ((match _.0 (`_.0 (lambda (x) x)) . _.1) 337 | (num _.0)) 338 | ((match _.0 (_.1 _.2) (_.0 (lambda (x) x)) . _.3) 339 | (=/= ((_.0 _.1))) (num _.0 _.1)) 340 | (match #t (#t (lambda (x) x)) . _.0) 341 | (((lambda (_.0) _.0) (lambda (x) x)) 342 | (sym _.0)) 343 | (match #f (`#f (lambda (x) x)) . _.0) 344 | ((match '_.0 (_.0 (lambda (x) x)) . _.1) 345 | (num _.0)) 346 | ((match _.0 (#f _.1) (_.0 (lambda (x) x)) . _.2) 347 | (num _.0)))) 348 | 349 | 350 | (printf "Long running tests...\n") 351 | 352 | (printf "This test takes a while...\n") 353 | (test "match-8-backwards" 354 | (run* (q) 355 | (eval-expo 356 | `(match '((lambda (y) (y z)) 5) 357 | [,q (cons rator (cons rand '()))]) 358 | '() 359 | '((lambda (y) (y z)) 5))) 360 | '(`(,rator ,rand) 361 | `(,rator ,(? number? rand)) 362 | (`(,rator ,rand unquote _.0) 363 | (=/= ((_.0 cons)) ((_.0 quote)) 364 | ((_.0 rand)) ((_.0 rator))) 365 | (sym _.0)) 366 | (`(,rator ,(? number? rand) unquote _.0) 367 | (=/= ((_.0 cons)) ((_.0 quote)) 368 | ((_.0 rand)) ((_.0 rator))) 369 | (sym _.0)))) 370 | 371 | (printf "This test takes a while...\n") 372 | (test "match-8-backwards-b" 373 | (run* (q) 374 | (eval-expo 375 | `(match '((lambda (y) (y z)) w) 376 | [,q (cons rator (cons rand '()))]) 377 | '() 378 | '((lambda (y) (y z)) w))) 379 | '(`(,rator ,rand) 380 | `(,rator ,(? symbol? rand)) 381 | (`(,rator ,rand unquote _.0) 382 | (=/= ((_.0 cons)) ((_.0 quote)) 383 | ((_.0 rand)) ((_.0 rator))) 384 | (sym _.0)) 385 | (`(,rator ,(? symbol? rand) unquote _.0) 386 | (=/= ((_.0 cons)) ((_.0 quote)) 387 | ((_.0 rand)) ((_.0 rator))) 388 | (sym _.0)))) 389 | 390 | 391 | #!eof 392 | 393 | ;; higher-order interpreter 394 | 395 | ;; ideal version 396 | ;; 397 | ;; letrec 398 | ;; multi-arg lambda/application 399 | ;; quote 400 | ;; equal? 401 | ;; if 402 | ;; error 403 | (letrec ((eval-expr 404 | (lambda (expr env) 405 | (match expr 406 | [(? symbol? x) (env x)] 407 | [`(lambda (,(? symbol? x)) ,body) 408 | (lambda (a) 409 | (eval-expr body (lambda (y) 410 | (if (equal? x y) 411 | a 412 | (env y)))))] 413 | [`(,rator ,rand) 414 | ((eval-expr rator env) (eval-expr rand env))])))) 415 | (eval-expr '((lambda (y) w) (lambda (z) z)) (lambda (y) (error 'unbound-variable y)))) 416 | 417 | 418 | ;; hack to avoid adding 'error': instead of representing empty env as 419 | ;; (lambda (y) (error 'unbound-variable)), can force failure by applying a 420 | ;; function with the wrong number of arguments 421 | ;; 422 | ;; letrec 423 | ;; multi-arg lambda/application 424 | ;; quote 425 | ;; equal? 426 | ;; if 427 | (letrec ((eval-expr 428 | (lambda (expr env) 429 | (match expr 430 | [(? symbol? x) (env x)] 431 | [`(lambda (,(? symbol? x)) ,body) 432 | (lambda (a) 433 | (eval-expr body (lambda (y) 434 | (if (equal? x y) 435 | a 436 | (env y)))))] 437 | [`(,rator ,rand) 438 | ((eval-expr rator env) (eval-expr rand env))])))) 439 | (eval-expr '((lambda (y) w) (lambda (z) z)) (lambda (y) ((lambda (z) z))))) 440 | 441 | 442 | ;; another possible approach, assuming 'match' is extended to handle 443 | ;; ,(quote ,datum). This seems a bit weird, though, in how we would 444 | ;; handle ,datum. 445 | ;; 446 | ;; letrec 447 | ;; multi-arg lambda/application 448 | ;; quote 449 | (letrec ((eval-expr 450 | (lambda (expr env) 451 | (match expr 452 | [(? symbol? x) (env x)] 453 | [`(lambda (,(? symbol? x)) ,body) 454 | (lambda (a) 455 | (eval-expr body (lambda (y) 456 | (match y 457 | [,(quote ,x) a] 458 | [,else (env y)]))))] 459 | [`(,rator ,rand) 460 | ((eval-expr rator env) (eval-expr rand env))])))) 461 | (eval-expr '((lambda (y) w) (lambda (z) z)) (lambda (y) ((lambda (z) z))))) 462 | -------------------------------------------------------------------------------- /variadic-lambda-with-map-tests.scm: -------------------------------------------------------------------------------- 1 | (load "interp-with-variadic-lambda-and-map-and-match.scm") 2 | (load "mk/test-check.scm") 3 | (load "mk/matche.scm") 4 | 5 | ;; Use a Scheme interpreter, written in Scheme using higher-order 6 | ;; representation of procedures and environments, running in a 7 | ;; relational Scheme interpreter, to generate quines and (I love you) 8 | ;; expressions. 9 | 10 | 11 | ;; Helper Scheme predicate for testing 12 | (define member? (lambda (x ls) (not (not (member x ls))))) 13 | 14 | 15 | ;; map tests 16 | 17 | (test "match-0" 18 | (run* (q) (eval-expo '(map (lambda (x) x) (list 3 4 5)) '() q)) 19 | '((3 4 5))) 20 | 21 | (test "match-1" 22 | (run* (q) (eval-expo '(map (lambda (x) 6) (list 3 4 5)) '() q)) 23 | '((6 6 6))) 24 | 25 | (test "match-2" 26 | (run* (q) (eval-expo '(map (lambda (x) (cons x x)) (list 3 4 5)) '() q)) 27 | '(((3 . 3) (4 . 4) (5 . 5)))) 28 | 29 | 30 | 31 | (test "Scheme-interpreter-list-map-1" 32 | (run 1 (q) 33 | (eval-expo 34 | `(letrec ((eval-expr 35 | (lambda (expr env) 36 | (match expr 37 | [`(quote ,datum) datum] 38 | [(? symbol? x) (env x)] 39 | [`(lambda (,(? symbol? x)) ,body) 40 | (lambda (a) 41 | (eval-expr body (lambda (y) 42 | (if (equal? x y) 43 | a 44 | (env y)))))] 45 | [`(list . ,e*) 46 | (map (lambda (e) (eval-expr e env)) e*)] 47 | [`(,rator ,rand) 48 | ((eval-expr rator env) (eval-expr rand env))])))) 49 | (eval-expr '(list '3 '4 '5) 50 | (lambda (y) ((lambda (z) z))))) 51 | '() 52 | q)) 53 | '((3 4 5))) 54 | 55 | ;; 25 collections 56 | ;; 3819 ms elapsed cpu time, including 18 ms collecting 57 | ;; 3819 ms elapsed real time, including 19 ms collecting 58 | ;; 211716736 bytes allocated 59 | (test "Scheme-interpreter-list-cons-love-1" 60 | (run 10 (q) 61 | (eval-expo 62 | `(letrec ((eval-expr 63 | (lambda (expr env) 64 | (match expr 65 | [`(quote ,datum) datum] 66 | [(? symbol? x) (env x)] 67 | [`(cons ,e1 ,e2) 68 | (cons (eval-expr e1 env) (eval-expr e2 env))] 69 | [`(list . ,e*) 70 | (map (lambda (e) (eval-expr e env)) e*)] 71 | [`(lambda (,(? symbol? x)) ,body) 72 | (lambda (a) 73 | (eval-expr body (lambda (y) 74 | (if (equal? x y) 75 | a 76 | (env y)))))] 77 | [`(,rator ,rand) 78 | ((eval-expr rator env) (eval-expr rand env))])))) 79 | (eval-expr ',q 80 | (lambda (y) ((lambda (z) z))))) 81 | '() 82 | '(I love you))) 83 | '('(I love you) 84 | (cons 'I '(love you)) 85 | (list 'I 'love 'you) 86 | (cons 'I (cons 'love '(you))) 87 | (cons 'I (list 'love 'you)) 88 | (cons 'I (cons 'love (cons 'you '()))) 89 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 90 | (sym _.0) (absento (closure _.1))) 91 | ((cons ((lambda (_.0) 'I) '_.1) '(love you)) 92 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 93 | (cons 'I (cons 'love (list 'you))) 94 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 95 | (sym _.0)))) 96 | 97 | ;; 30 collections 98 | ;; 6202 ms elapsed cpu time, including 33 ms collecting 99 | ;; 6206 ms elapsed real time, including 33 ms collecting 100 | ;; 252558864 bytes allocated 101 | (test "Scheme-interpreter-list-cons-love-no-map-1b" 102 | ;; list implemented with letrec rather than with map 103 | (run 10 (q) 104 | (eval-expo 105 | `(letrec ((eval-expr 106 | (lambda (expr env) 107 | (match expr 108 | [`(quote ,datum) datum] 109 | [(? symbol? x) (env x)] 110 | [`(cons ,e1 ,e2) 111 | (cons (eval-expr e1 env) (eval-expr e2 env))] 112 | [`(list . ,e*) 113 | (letrec ((loop (lambda (e*) 114 | (if (null? e*) 115 | '() 116 | (cons (eval-expr (car e*) env) (loop (cdr e*))))))) 117 | (loop e*))] 118 | [`(lambda (,(? symbol? x)) ,body) 119 | (lambda (a) 120 | (eval-expr body (lambda (y) 121 | (if (equal? x y) 122 | a 123 | (env y)))))] 124 | [`(,rator ,rand) 125 | ((eval-expr rator env) (eval-expr rand env))])))) 126 | (eval-expr ',q 127 | (lambda (y) ((lambda (z) z))))) 128 | '() 129 | '(I love you))) 130 | '('(I love you) 131 | (cons 'I '(love you)) 132 | (cons 'I (cons 'love '(you))) 133 | (list 'I 'love 'you) 134 | (cons 'I (cons 'love (cons 'you '()))) 135 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 136 | (sym _.0) (absento (closure _.1))) 137 | ((cons ((lambda (_.0) 'I) '_.1) '(love you)) 138 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 139 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 140 | (sym _.0)) 141 | (cons 'I (list 'love 'you)) 142 | ((cons ((lambda (_.0) 'I) '_.1) (cons 'love '(you))) 143 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))))) 144 | 145 | ;; 441 collections 146 | ;; 244419 ms elapsed cpu time, including 1782 ms collecting 147 | ;; 244804 ms elapsed real time, including 1787 ms collecting 148 | ;; 3693675840 bytes allocated 149 | (test "Scheme-interpreter-list-cons-love-2" 150 | (run 99 (q) 151 | (eval-expo 152 | `(letrec ((eval-expr 153 | (lambda (expr env) 154 | (match expr 155 | [`(quote ,datum) datum] 156 | [(? symbol? x) (env x)] 157 | [`(cons ,e1 ,e2) 158 | (cons (eval-expr e1 env) (eval-expr e2 env))] 159 | [`(list . ,e*) 160 | (map (lambda (e) (eval-expr e env)) e*)] 161 | [`(lambda (,(? symbol? x)) ,body) 162 | (lambda (a) 163 | (eval-expr body (lambda (y) 164 | (if (equal? x y) 165 | a 166 | (env y)))))] 167 | [`(,rator ,rand) 168 | ((eval-expr rator env) (eval-expr rand env))])))) 169 | (eval-expr ',q 170 | (lambda (y) ((lambda (z) z))))) 171 | '() 172 | '(I love you))) 173 | '('(I love you) 174 | (cons 'I '(love you)) 175 | (list 'I 'love 'you) 176 | (cons 'I (cons 'love '(you))) 177 | (cons 'I (list 'love 'you)) 178 | (cons 'I (cons 'love (cons 'you '()))) 179 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 180 | (sym _.0) (absento (closure _.1))) 181 | ((cons ((lambda (_.0) 'I) '_.1) '(love you)) 182 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 183 | (cons 'I (cons 'love (list 'you))) 184 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 185 | (sym _.0)) 186 | ((cons ((lambda (_.0) 'I) '_.1) (cons 'love '(you))) 187 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 188 | ((cons ((lambda (_.0) _.0) 'I) '(love you)) 189 | (=/= ((_.0 closure))) (sym _.0)) 190 | (((lambda (_.0) (cons 'I '(love you))) '_.1) 191 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 192 | ((cons ((lambda (_.0) 'I) '_.1) (list 'love 'you)) 193 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 194 | (((lambda (_.0) '(I love you)) (list)) 195 | (=/= ((_.0 closure))) (sym _.0)) 196 | (cons 'I (cons 'love (cons 'you (list)))) 197 | ((cons ((lambda (_.0) _.0) 'I) (cons 'love '(you))) 198 | (=/= ((_.0 closure))) (sym _.0)) 199 | ((list ((lambda (_.0) 'I) '_.1) 'love 'you) 200 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 201 | (((lambda (_.0) (cons 'I _.0)) '(love you)) 202 | (=/= ((_.0 closure))) (sym _.0)) 203 | (((lambda (_.0) '(I love you)) (lambda (_.1) _.2)) 204 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 205 | (absento (closure _.2))) 206 | (((lambda (_.0) (cons _.0 '(love you))) 'I) 207 | (=/= ((_.0 closure))) (sym _.0)) 208 | ((cons ((lambda (_.0) 'I) '_.1) 209 | (cons 'love (cons 'you '()))) 210 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 211 | (((lambda (_.0) '(I love you)) (cons '_.1 '_.2)) 212 | (=/= ((_.0 closure))) (sym _.0) 213 | (absento (closure _.1) (closure _.2))) 214 | ((cons ((lambda (_.0) 'I) '_.1) (cons 'love (list 'you))) 215 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 216 | (((lambda (_.0) (cons 'I '(love you))) (list)) 217 | (=/= ((_.0 closure))) (sym _.0)) 218 | ((cons ((lambda (_.0) _.0) 'I) (list 'love 'you)) 219 | (=/= ((_.0 closure))) (sym _.0)) 220 | ((list ((lambda (_.0) _.0) 'I) 'love 'you) 221 | (=/= ((_.0 closure))) (sym _.0)) 222 | ((cons 'I ((lambda (_.0) '(love you)) '_.1)) 223 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 224 | (((lambda (_.0) (list 'I 'love 'you)) '_.1) 225 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 226 | ((list 'I 'love ((lambda (_.0) 'you) '_.1)) 227 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 228 | ((list 'I ((lambda (_.0) 'love) '_.1) 'you) 229 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 230 | ((cons 'I (cons ((lambda (_.0) 'love) '_.1) '(you))) 231 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 232 | (((lambda (_.0) (cons 'I (cons 'love '(you)))) '_.1) 233 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 234 | (((lambda (_.0) _.0) (cons 'I '(love you))) 235 | (=/= ((_.0 closure))) (sym _.0)) 236 | ((cons ((lambda (_.0) _.0) 'I) 237 | (cons 'love (cons 'you '()))) 238 | (=/= ((_.0 closure))) (sym _.0)) 239 | ((cons 'I ((lambda (_.0) _.0) '(love you))) 240 | (=/= ((_.0 closure))) (sym _.0)) 241 | ((cons ((lambda (_.0) 'I) (list)) '(love you)) 242 | (=/= ((_.0 closure))) (sym _.0)) 243 | (((lambda (_.0) (cons 'I '(love you))) (lambda (_.1) _.2)) 244 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 245 | (absento (closure _.2))) 246 | ((cons ((lambda (_.0) 'I) '_.1) 247 | (cons 'love (cons 'you (list)))) 248 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 249 | ((list 'I 'love ((lambda (_.0) _.0) 'you)) 250 | (=/= ((_.0 closure))) (sym _.0)) 251 | ((cons 'I 252 | (cons ((lambda (_.0) 'love) '_.1) (cons 'you '()))) 253 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 254 | ((cons ((lambda (_.0) _.0) 'I) (cons 'love (list 'you))) 255 | (=/= ((_.0 closure))) (sym _.0)) 256 | ((cons ((lambda (_.0) 'I) (list)) (cons 'love '(you))) 257 | (=/= ((_.0 closure))) (sym _.0)) 258 | ((cons 'I (cons ((lambda (_.0) 'love) '_.1) (list 'you))) 259 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 260 | (((lambda (_.0) (list _.0 'love 'you)) 'I) 261 | (=/= ((_.0 closure))) (sym _.0)) 262 | (((lambda (_.0) (list 'I 'love _.0)) 'you) 263 | (=/= ((_.0 closure))) (sym _.0)) 264 | ((list 'I ((lambda (_.0) _.0) 'love) 'you) 265 | (=/= ((_.0 closure))) (sym _.0)) 266 | ((cons 'I (cons ((lambda (_.0) _.0) 'love) '(you))) 267 | (=/= ((_.0 closure))) (sym _.0)) 268 | (((lambda (_.0) (cons 'I (cons 'love _.0))) '(you)) 269 | (=/= ((_.0 closure))) (sym _.0)) 270 | ((cons 'I ((lambda (_.0) (cons 'love '(you))) '_.1)) 271 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 272 | (((lambda (_.0) (list 'I _.0 'you)) 'love) 273 | (=/= ((_.0 closure))) (sym _.0)) 274 | (((lambda (_.0) (cons 'I (cons _.0 '(you)))) 'love) 275 | (=/= ((_.0 closure))) (sym _.0)) 276 | (((lambda (_.0) (cons _.0 (cons 'love '(you)))) 'I) 277 | (=/= ((_.0 closure))) (sym _.0)) 278 | (((lambda (_.0) (list 'I 'love 'you)) (list)) 279 | (=/= ((_.0 closure))) (sym _.0)) 280 | ((cons 'I ((lambda (_.0) '(love you)) (list))) 281 | (=/= ((_.0 closure))) (sym _.0)) 282 | ((cons 'I 283 | (cons ((lambda (_.0) 'love) '_.1) (cons 'you (list)))) 284 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 285 | ((cons ((lambda (_.0) 'I) '_.1) 286 | ((lambda (_.2) '(love you)) '_.3)) 287 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 288 | (absento (closure _.1) (closure _.3))) 289 | ((cons ((lambda (_.0) 'I) (list)) (list 'love 'you)) 290 | (=/= ((_.0 closure))) (sym _.0)) 291 | (((lambda (_.0) (cons 'I '(love you))) (cons '_.1 '_.2)) 292 | (=/= ((_.0 closure))) (sym _.0) 293 | (absento (closure _.1) (closure _.2))) 294 | ((list 'I 'love ((lambda (_.0) 'you) (list))) 295 | (=/= ((_.0 closure))) (sym _.0)) 296 | ((cons 'I (list 'love ((lambda (_.0) 'you) '_.1))) 297 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 298 | (((lambda (_.0) (cons 'I (cons 'love '(you)))) (list)) 299 | (=/= ((_.0 closure))) (sym _.0)) 300 | ((cons 'I (list ((lambda (_.0) 'love) '_.1) 'you)) 301 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 302 | (((lambda (_.0) (cons 'I (list 'love 'you))) '_.1) 303 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 304 | ((cons 'I 305 | (cons ((lambda (_.0) _.0) 'love) (cons 'you '()))) 306 | (=/= ((_.0 closure))) (sym _.0)) 307 | ((cons ((lambda (_.0) 'I) (lambda (_.1) _.2)) '(love you)) 308 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 309 | (absento (closure _.2))) 310 | ((cons 'I ((lambda (_.0) (cons 'love _.0)) '(you))) 311 | (=/= ((_.0 closure))) (sym _.0)) 312 | (((lambda (_.0) '(I love you)) (list '_.1)) 313 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 314 | ((cons ((lambda (_.0) 'I) '_.1) 315 | (cons ((lambda (_.2) 'love) '_.3) '(you))) 316 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 317 | (absento (closure _.1) (closure _.3))) 318 | ((cons ((lambda (_.0) _.0) 'I) 319 | (cons 'love (cons 'you (list)))) 320 | (=/= ((_.0 closure))) (sym _.0)) 321 | ((cons 'I ((lambda (_.0) '(love you)) (lambda (_.1) _.2))) 322 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 323 | (absento (closure _.2))) 324 | ((cons 'I ((lambda (_.0) (cons _.0 '(you))) 'love)) 325 | (=/= ((_.0 closure))) (sym _.0)) 326 | ((list ((lambda (_.0) 'I) (list)) 'love 'you) 327 | (=/= ((_.0 closure))) (sym _.0)) 328 | ((cons 'I (cons ((lambda (_.0) _.0) 'love) (list 'you))) 329 | (=/= ((_.0 closure))) (sym _.0)) 330 | ((list ((lambda (_.0) 'I) '_.1) 'love 331 | ((lambda (_.2) 'you) '_.3)) 332 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 333 | (absento (closure _.1) (closure _.3))) 334 | ((list ((lambda (_.0) 'I) '_.1) 335 | ((lambda (_.2) 'love) '_.3) 'you) 336 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 337 | (absento (closure _.1) (closure _.3))) 338 | ((cons ((lambda (_.0) 'I) '_.1) 339 | ((lambda (_.2) _.2) '(love you))) 340 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 341 | (absento (closure _.1))) 342 | ((list 'I 'love ((lambda (_.0) 'you) (lambda (_.1) _.2))) 343 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 344 | (absento (closure _.2))) 345 | ((cons ((lambda (_.0) 'I) (list)) 346 | (cons 'love (cons 'you '()))) 347 | (=/= ((_.0 closure))) (sym _.0)) 348 | ((cons 'I (list 'love ((lambda (_.0) _.0) 'you))) 349 | (=/= ((_.0 closure))) (sym _.0)) 350 | ((cons 'I ((lambda (_.0) (list 'love 'you)) '_.1)) 351 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 352 | ((cons ((lambda (_.0) 'I) (lambda (_.1) _.2)) 353 | (cons 'love '(you))) 354 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 355 | (absento (closure _.2))) 356 | ((cons ((lambda (_.0) 'I) '_.1) 357 | (cons ((lambda (_.2) 'love) '_.3) (cons 'you '()))) 358 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 359 | (absento (closure _.1) (closure _.3))) 360 | ((list 'I ((lambda (_.0) 'love) '_.1) 361 | ((lambda (_.2) 'you) '_.3)) 362 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 363 | (absento (closure _.1) (closure _.3))) 364 | ((list ((lambda (_.0) 'I) '_.1) 'love 365 | ((lambda (_.2) _.2) 'you)) 366 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 367 | (absento (closure _.1))) 368 | ((cons 'I ((lambda (_.0) '(love you)) (cons '_.1 '_.2))) 369 | (=/= ((_.0 closure))) (sym _.0) 370 | (absento (closure _.1) (closure _.2))) 371 | ((cons 'I ((lambda (_.0) (cons 'love '(you))) (list))) 372 | (=/= ((_.0 closure))) (sym _.0)) 373 | (((lambda (_.0) (cons 'I _.0)) (cons 'love '(you))) 374 | (=/= ((_.0 closure))) (sym _.0)) 375 | ((cons ((lambda (_.0) 'I) '_.1) 376 | (cons ((lambda (_.2) 'love) '_.3) (list 'you))) 377 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 378 | (absento (closure _.1) (closure _.3))) 379 | ((cons 'I (list ((lambda (_.0) _.0) 'love) 'you)) 380 | (=/= ((_.0 closure))) (sym _.0)) 381 | ((list 'I 'love ((lambda (_.0) 'you) (cons '_.1 '_.2))) 382 | (=/= ((_.0 closure))) (sym _.0) 383 | (absento (closure _.1) (closure _.2))) 384 | ((cons ((lambda (_.0) 'I) (list)) (cons 'love (list 'you))) 385 | (=/= ((_.0 closure))) (sym _.0)) 386 | ((cons ((lambda (_.0) 'I) '_.1) 387 | (cons ((lambda (_.2) _.2) 'love) '(you))) 388 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 389 | (absento (closure _.1))) 390 | ((cons 'I 391 | (cons ((lambda (_.0) _.0) 'love) (cons 'you (list)))) 392 | (=/= ((_.0 closure))) (sym _.0)) 393 | ((cons 'I (cons 'love ((lambda (_.0) '(you)) '_.1))) 394 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 395 | ((cons ((lambda (_.0) 'I) '_.1) 396 | ((lambda (_.2) (cons 'love '(you))) '_.3)) 397 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 398 | (absento (closure _.1) (closure _.3))) 399 | ((list 'I ((lambda (_.0) 'love) '_.1) 400 | ((lambda (_.2) _.2) 'you)) 401 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 402 | (absento (closure _.1))) 403 | (((lambda (_.0) (cons 'I (cons 'love (cons 'you '())))) 404 | '_.1) 405 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 406 | ((list ((lambda (_.0) 'I) '_.1) ((lambda (_.2) _.2) 'love) 407 | 'you) 408 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 409 | (absento (closure _.1))))) 410 | 411 | ;; 29 collections 412 | ;; 6299 ms elapsed cpu time, including 23 ms collecting 413 | ;; 6301 ms elapsed real time, including 23 ms collecting 414 | ;; 241978816 bytes allocated 415 | (test "Scheme-interpreter-list-love-1" 416 | (run 10 (q) 417 | (eval-expo 418 | `(letrec ((eval-expr 419 | (lambda (expr env) 420 | (match expr 421 | [`(quote ,datum) datum] 422 | [(? symbol? x) (env x)] 423 | [`(list . ,e*) 424 | (map (lambda (e) (eval-expr e env)) e*)] 425 | [`(lambda (,(? symbol? x)) ,body) 426 | (lambda (a) 427 | (eval-expr body (lambda (y) 428 | (if (equal? x y) 429 | a 430 | (env y)))))] 431 | [`(,rator ,rand) 432 | ((eval-expr rator env) (eval-expr rand env))])))) 433 | (eval-expr ',q 434 | (lambda (y) ((lambda (z) z))))) 435 | '() 436 | '(I love you))) 437 | '('(I love you) 438 | (list 'I 'love 'you) 439 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 440 | (sym _.0) (absento (closure _.1))) 441 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 442 | (sym _.0)) 443 | (((lambda (_.0) '(I love you)) (list)) 444 | (=/= ((_.0 closure))) (sym _.0)) 445 | ((list ((lambda (_.0) 'I) '_.1) 'love 'you) 446 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 447 | (((lambda (_.0) '(I love you)) (lambda (_.1) _.2)) 448 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 449 | (absento (closure _.2))) 450 | (((lambda (_.0) (list 'I 'love 'you)) '_.1) 451 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 452 | ((list 'I 'love ((lambda (_.0) 'you) '_.1)) 453 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 454 | ((list 'I ((lambda (_.0) 'love) '_.1) 'you) 455 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))))) 456 | 457 | ;; 51 collections 458 | ;; 19822 ms elapsed cpu time, including 56 ms collecting 459 | ;; 19906 ms elapsed real time, including 57 ms collecting 460 | ;; 429917424 bytes allocated 461 | (test "Scheme-interpreter-list-love-no-map-1" 462 | (run 10 (q) 463 | (eval-expo 464 | `(letrec ((eval-expr 465 | (lambda (expr env) 466 | (match expr 467 | [`(quote ,datum) datum] 468 | [(? symbol? x) (env x)] 469 | [`(list . ,e*) 470 | (letrec ((loop (lambda (e*) 471 | (if (null? e*) 472 | '() 473 | (cons (eval-expr (car e*) env) (loop (cdr e*))))))) 474 | (loop e*))] 475 | [`(lambda (,(? symbol? x)) ,body) 476 | (lambda (a) 477 | (eval-expr body (lambda (y) 478 | (if (equal? x y) 479 | a 480 | (env y)))))] 481 | [`(,rator ,rand) 482 | ((eval-expr rator env) (eval-expr rand env))])))) 483 | (eval-expr ',q 484 | (lambda (y) ((lambda (z) z))))) 485 | '() 486 | '(I love you))) 487 | '('(I love you) 488 | (list 'I 'love 'you) 489 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 490 | (sym _.0) (absento (closure _.1))) 491 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 492 | (sym _.0)) 493 | (((lambda (_.0) '(I love you)) (lambda (_.1) _.2)) 494 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 495 | (absento (closure _.2))) 496 | (((lambda (_.0) '(I love you)) (list)) 497 | (=/= ((_.0 closure))) (sym _.0)) 498 | ((list ((lambda (_.0) 'I) '_.1) 'love 'you) 499 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 500 | ((list 'I 'love ((lambda (_.0) 'you) '_.1)) 501 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 502 | ((list 'I ((lambda (_.0) 'love) '_.1) 'you) 503 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 504 | ((list ((lambda (_.0) _.0) 'I) 'love 'you) 505 | (=/= ((_.0 closure))) (sym _.0)))) 506 | 507 | ;; 53 collections 508 | ;; 22232 ms elapsed cpu time, including 51 ms collecting 509 | ;; 22242 ms elapsed real time, including 51 ms collecting 510 | ;; 444486784 bytes allocated 511 | (test "Scheme-interpreter-list-love-local-map-1" 512 | ;; list implemented with map, defined locally 513 | (run 10 (q) 514 | (eval-expo 515 | `(letrec ((map (lambda (f ls) 516 | (if (null? ls) 517 | '() 518 | (cons (f (car ls)) (map f (cdr ls))))))) 519 | (letrec ((eval-expr 520 | (lambda (expr env) 521 | (match expr 522 | [`(quote ,datum) datum] 523 | [(? symbol? x) (env x)] 524 | [`(list . ,e*) 525 | (map (lambda (e) (eval-expr e env)) e*)] 526 | [`(lambda (,(? symbol? x)) ,body) 527 | (lambda (a) 528 | (eval-expr body (lambda (y) 529 | (if (equal? x y) 530 | a 531 | (env y)))))] 532 | [`(,rator ,rand) 533 | ((eval-expr rator env) (eval-expr rand env))])))) 534 | (eval-expr ',q 535 | (lambda (y) ((lambda (z) z)))))) 536 | '() 537 | '(I love you))) 538 | '('(I love you) 539 | (list 'I 'love 'you) 540 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 541 | (sym _.0) (absento (closure _.1))) 542 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 543 | (sym _.0)) 544 | (((lambda (_.0) '(I love you)) (lambda (_.1) _.2)) 545 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 546 | (absento (closure _.2))) 547 | (((lambda (_.0) '(I love you)) (list)) 548 | (=/= ((_.0 closure))) (sym _.0)) 549 | ((list ((lambda (_.0) 'I) '_.1) 'love 'you) 550 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 551 | ((list 'I 'love ((lambda (_.0) 'you) '_.1)) 552 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 553 | ((list 'I ((lambda (_.0) 'love) '_.1) 'you) 554 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 555 | ((list ((lambda (_.0) _.0) 'I) 'love 'you) 556 | (=/= ((_.0 closure))) (sym _.0)))) 557 | 558 | ;; 542 collections 559 | ;; 376792 ms elapsed cpu time, including 2521 ms collecting 560 | ;; 377667 ms elapsed real time, including 2530 ms collecting 561 | ;; 4541768432 bytes allocated 562 | (test "Scheme-interpreter-list-love-2" 563 | (run 99 (q) 564 | (eval-expo 565 | `(letrec ((eval-expr 566 | (lambda (expr env) 567 | (match expr 568 | [`(quote ,datum) datum] 569 | [(? symbol? x) (env x)] 570 | [`(list . ,e*) 571 | (map (lambda (e) (eval-expr e env)) e*)] 572 | [`(lambda (,(? symbol? x)) ,body) 573 | (lambda (a) 574 | (eval-expr body (lambda (y) 575 | (if (equal? x y) 576 | a 577 | (env y)))))] 578 | [`(,rator ,rand) 579 | ((eval-expr rator env) (eval-expr rand env))])))) 580 | (eval-expr ',q 581 | (lambda (y) ((lambda (z) z))))) 582 | '() 583 | '(I love you))) 584 | '('(I love you) 585 | (list 'I 'love 'you) 586 | (((lambda (_.0) '(I love you)) '_.1) (=/= ((_.0 closure))) 587 | (sym _.0) (absento (closure _.1))) 588 | (((lambda (_.0) _.0) '(I love you)) (=/= ((_.0 closure))) 589 | (sym _.0)) 590 | (((lambda (_.0) '(I love you)) (list)) 591 | (=/= ((_.0 closure))) (sym _.0)) 592 | ((list ((lambda (_.0) 'I) '_.1) 'love 'you) 593 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 594 | (((lambda (_.0) '(I love you)) (lambda (_.1) _.2)) 595 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 596 | (absento (closure _.2))) 597 | (((lambda (_.0) (list 'I 'love 'you)) '_.1) 598 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 599 | ((list 'I 'love ((lambda (_.0) 'you) '_.1)) 600 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 601 | ((list 'I ((lambda (_.0) 'love) '_.1) 'you) 602 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 603 | ((list ((lambda (_.0) _.0) 'I) 'love 'you) 604 | (=/= ((_.0 closure))) (sym _.0)) 605 | (((lambda (_.0) (list 'I 'love _.0)) 'you) 606 | (=/= ((_.0 closure))) (sym _.0)) 607 | (((lambda (_.0) (list _.0 'love 'you)) 'I) 608 | (=/= ((_.0 closure))) (sym _.0)) 609 | (((lambda (_.0) '(I love you)) (list '_.1)) 610 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 611 | (((lambda (_.0) (list 'I 'love 'you)) (list)) 612 | (=/= ((_.0 closure))) (sym _.0)) 613 | (((lambda (_.0) (list 'I _.0 'you)) 'love) 614 | (=/= ((_.0 closure))) (sym _.0)) 615 | ((list 'I 'love ((lambda (_.0) _.0) 'you)) 616 | (=/= ((_.0 closure))) (sym _.0)) 617 | ((list 'I ((lambda (_.0) _.0) 'love) 'you) 618 | (=/= ((_.0 closure))) (sym _.0)) 619 | ((list 'I 'love ((lambda (_.0) 'you) (list))) 620 | (=/= ((_.0 closure))) (sym _.0)) 621 | (((lambda (_.0) (list 'I 'love 'you)) (lambda (_.1) _.2)) 622 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 623 | (absento (closure _.2))) 624 | (((lambda (_.0) ((lambda (_.1) '(I love you)) '_.2)) '_.3) 625 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 626 | (absento (closure _.2) (closure _.3))) 627 | ((list ((lambda (_.0) 'I) '_.1) 'love 628 | ((lambda (_.2) 'you) '_.3)) 629 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 630 | (absento (closure _.1) (closure _.3))) 631 | ((list ((lambda (_.0) 'I) '_.1) 632 | ((lambda (_.2) 'love) '_.3) 'you) 633 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 634 | (absento (closure _.1) (closure _.3))) 635 | ((list ((lambda (_.0) 'I) (list)) 'love 'you) 636 | (=/= ((_.0 closure))) (sym _.0)) 637 | ((list 'I 'love ((lambda (_.0) 'you) (lambda (_.1) _.2))) 638 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 639 | (absento (closure _.2))) 640 | (((lambda (_.0) '(I love you)) (list '_.1 '_.2)) 641 | (=/= ((_.0 closure))) (sym _.0) 642 | (absento (closure _.1) (closure _.2))) 643 | ((list 'I ((lambda (_.0) 'love) '_.1) 644 | ((lambda (_.2) 'you) '_.3)) 645 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 646 | (absento (closure _.1) (closure _.3))) 647 | (((lambda (_.0) ((lambda (_.1) _.1) '(I love you))) '_.2) 648 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 649 | (absento (closure _.2))) 650 | ((list ((lambda (_.0) 'I) '_.1) 'love 651 | ((lambda (_.2) _.2) 'you)) 652 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 653 | (absento (closure _.1))) 654 | ((list 'I ((lambda (_.0) 'love) '_.1) 655 | ((lambda (_.2) _.2) 'you)) 656 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 657 | (absento (closure _.1))) 658 | (((lambda (_.0) ((lambda (_.1) _.0) '_.2)) '(I love you)) 659 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.1 closure))) 660 | (sym _.0 _.1) (absento (closure _.2))) 661 | ((list ((lambda (_.0) 'I) '_.1) ((lambda (_.2) _.2) 'love) 662 | 'you) 663 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 664 | (absento (closure _.1))) 665 | (((lambda (_.0) ((lambda (_.1) '(I love you)) '_.2)) 666 | (list)) 667 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 668 | (absento (closure _.2))) 669 | (((lambda (_.0) (list 'I 'love 'you)) (list '_.1)) 670 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 671 | (((lambda (_.0) ((lambda (_.1) '(I love you)) _.0)) '_.2) 672 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 673 | (absento (closure _.2))) 674 | ((list ((lambda (_.0) 'I) '_.1) 'love 675 | ((lambda (_.2) 'you) (list))) 676 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 677 | (absento (closure _.1))) 678 | ((list 'I ((lambda (_.0) 'love) (list)) 'you) 679 | (=/= ((_.0 closure))) (sym _.0)) 680 | ((list ((lambda (_.0) 'I) (lambda (_.1) _.2)) 'love 'you) 681 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 682 | (absento (closure _.2))) 683 | ((list ((lambda (_.0) _.0) 'I) 'love 684 | ((lambda (_.1) 'you) '_.2)) 685 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 686 | (absento (closure _.2))) 687 | ((list ((lambda (_.0) _.0) 'I) ((lambda (_.1) 'love) '_.2) 688 | 'you) 689 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 690 | (absento (closure _.2))) 691 | ((list 'I 'love ((lambda (_.0) 'you) (list '_.1))) 692 | (=/= ((_.0 closure))) (sym _.0) (absento (closure _.1))) 693 | ((list 'I ((lambda (_.0) 'love) '_.1) 694 | ((lambda (_.2) 'you) (list))) 695 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 696 | (absento (closure _.1))) 697 | ((list ((lambda (_.0) 'I) '_.1) 'love 698 | ((lambda (_.2) 'you) (lambda (_.3) _.4))) 699 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.3 closure))) 700 | (sym _.0 _.2 _.3) (absento (closure _.1) (closure _.4))) 701 | ((list 'I ((lambda (_.0) _.0) 'love) 702 | ((lambda (_.1) 'you) '_.2)) 703 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 704 | (absento (closure _.2))) 705 | ((list 'I 'love 706 | ((lambda (_.0) ((lambda (_.1) 'you) '_.2)) '_.3)) 707 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 708 | (absento (closure _.2) (closure _.3))) 709 | ((list 'I ((lambda (_.0) 'love) '_.1) 710 | ((lambda (_.2) 'you) (lambda (_.3) _.4))) 711 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.3 closure))) 712 | (sym _.0 _.2 _.3) (absento (closure _.1) (closure _.4))) 713 | ((list ((lambda (_.0) 'I) '_.1) 714 | ((lambda (_.2) 'love) '_.3) ((lambda (_.4) 'you) '_.5)) 715 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.4 closure))) 716 | (sym _.0 _.2 _.4) 717 | (absento (closure _.1) (closure _.3) (closure _.5))) 718 | (((lambda (_.0) ((lambda (_.1) _.1) '(I love you))) (list)) 719 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 720 | (((lambda (_.0) ((lambda (_.1) _.1) _.0)) '(I love you)) 721 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 722 | ((list ((lambda (_.0) _.0) 'I) 'love 723 | ((lambda (_.1) _.1) 'you)) 724 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 725 | (((lambda (_.0) (_.0 '_.1)) (lambda (_.2) '(I love you))) 726 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 727 | ((_.0 quote)) ((_.2 closure))) 728 | (sym _.0 _.2) (absento (closure _.1))) 729 | (((lambda (_.0) ((lambda (_.1) '(I love you)) (list))) 730 | '_.2) 731 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 732 | (absento (closure _.2))) 733 | (((lambda (_.0) ((lambda (_.1) _.0) _.0)) '(I love you)) 734 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.1 closure))) 735 | (sym _.0 _.1)) 736 | ((list 'I ((lambda (_.0) _.0) 'love) 737 | ((lambda (_.1) _.1) 'you)) 738 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 739 | ((list 'I 'love 740 | ((lambda (_.0) ((lambda (_.1) _.1) 'you)) '_.2)) 741 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 742 | (absento (closure _.2))) 743 | (((lambda (_.0) ((lambda (_.1) (list 'I 'love 'you)) '_.2)) 744 | '_.3) 745 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 746 | (absento (closure _.2) (closure _.3))) 747 | ((list ((lambda (_.0) 'I) '_.1) 748 | ((lambda (_.2) 'love) '_.3) ((lambda (_.4) _.4) 'you)) 749 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.4 closure))) 750 | (sym _.0 _.2 _.4) (absento (closure _.1) (closure _.3))) 751 | (((lambda (_.0) '(I love you)) (list '_.1 '_.2 '_.3)) 752 | (=/= ((_.0 closure))) (sym _.0) 753 | (absento (closure _.1) (closure _.2) (closure _.3))) 754 | ((list ((lambda (_.0) _.0) 'I) ((lambda (_.1) _.1) 'love) 755 | 'you) 756 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 757 | ((list 'I ((lambda (_.0) 'love) (lambda (_.1) _.2)) 'you) 758 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 759 | (absento (closure _.2))) 760 | (((lambda (_.0) ((lambda (_.1) '(I love you)) _.0)) (list)) 761 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 762 | ((list ((lambda (_.0) _.0) 'I) 'love 763 | ((lambda (_.1) 'you) (list))) 764 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 765 | (((lambda (_.0) 766 | ((lambda (_.1) '(I love you)) (lambda (_.2) _.3))) 767 | '_.4) 768 | (=/= ((_.0 closure)) ((_.1 closure)) ((_.2 closure))) 769 | (sym _.0 _.1 _.2) (absento (closure _.3) (closure _.4))) 770 | (((lambda (_.0) (list 'I 'love ((lambda (_.1) 'you) '_.2))) 771 | '_.3) 772 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 773 | (absento (closure _.2) (closure _.3))) 774 | (((lambda (_.0) (list 'I 'love 'you)) (list '_.1 '_.2)) 775 | (=/= ((_.0 closure))) (sym _.0) 776 | (absento (closure _.1) (closure _.2))) 777 | ((list 'I 'love 778 | ((lambda (_.0) ((lambda (_.1) _.0) '_.2)) 'you)) 779 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.1 closure))) 780 | (sym _.0 _.1) (absento (closure _.2))) 781 | ((list ((lambda (_.0) 'I) '_.1) 782 | ((lambda (_.2) 'love) (list)) 'you) 783 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 784 | (absento (closure _.1))) 785 | (((lambda (_.0) (list ((lambda (_.1) 'I) '_.2) 'love 'you)) 786 | '_.3) 787 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 788 | (absento (closure _.2) (closure _.3))) 789 | ((list ((lambda (_.0) 'I) (list)) 'love 790 | ((lambda (_.1) 'you) '_.2)) 791 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 792 | (absento (closure _.2))) 793 | (((lambda (_.0) _.0) (list 'I 'love 'you)) 794 | (=/= ((_.0 closure))) (sym _.0)) 795 | ((list ((lambda (_.0) 'I) (list)) 796 | ((lambda (_.1) 'love) '_.2) 'you) 797 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 798 | (absento (closure _.2))) 799 | ((list 'I ((lambda (_.0) _.0) 'love) 800 | ((lambda (_.1) 'you) (list))) 801 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)) 802 | ((list 'I 'love 803 | ((lambda (_.0) ((lambda (_.1) 'you) _.0)) '_.2)) 804 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 805 | (absento (closure _.2))) 806 | (((lambda (_.0) (list ((lambda (_.1) 'I) '_.2) 'love 'you)) 807 | (list)) 808 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 809 | (absento (closure _.2))) 810 | (((lambda (_.0) (_.0 '(I love you))) (lambda (_.1) _.1)) 811 | (=/= ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 812 | ((_.0 quote)) ((_.1 closure))) 813 | (sym _.0 _.1)) 814 | ((list ((lambda (_.0) 'I) '_.1) 'love 815 | ((lambda (_.2) 'you) (list '_.3))) 816 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 817 | (absento (closure _.1) (closure _.3))) 818 | ((list ((lambda (_.0) 'I) '_.1) 819 | ((lambda (_.2) 'love) '_.3) 820 | ((lambda (_.4) 'you) (list))) 821 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.4 closure))) 822 | (sym _.0 _.2 _.4) (absento (closure _.1) (closure _.3))) 823 | ((list 'I 'love 824 | ((lambda (_.0) ((lambda (_.1) 'you) '_.2)) (list))) 825 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 826 | (absento (closure _.2))) 827 | (((lambda (lambda) (lambda lambda)) 828 | (lambda (_.0) '(I love you))) 829 | (=/= ((_.0 closure))) (sym _.0)) 830 | ((list 'I 'love ((lambda (_.0) 'you) (list '_.1 '_.2))) 831 | (=/= ((_.0 closure))) (sym _.0) 832 | (absento (closure _.1) (closure _.2))) 833 | (((lambda (_.0) ((lambda (_.1) _.0) (list))) '(I love you)) 834 | (=/= ((_.0 _.1)) ((_.0 closure)) ((_.1 closure))) 835 | (sym _.0 _.1)) 836 | ((list 'I ((lambda (_.0) 'love) '_.1) 837 | ((lambda (_.2) 'you) (list '_.3))) 838 | (=/= ((_.0 closure)) ((_.2 closure))) (sym _.0 _.2) 839 | (absento (closure _.1) (closure _.3))) 840 | ((list ((lambda (_.0) _.0) 'I) 'love 841 | ((lambda (_.1) 'you) (lambda (_.2) _.3))) 842 | (=/= ((_.0 closure)) ((_.1 closure)) ((_.2 closure))) 843 | (sym _.0 _.1 _.2) (absento (closure _.3))) 844 | (((lambda (_.0) (list ((lambda (_.1) 'I) '_.2) 'love _.0)) 845 | 'you) 846 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 847 | (absento (closure _.2))) 848 | (((lambda (_.0) ((lambda (_.1) (list 'I 'love _.1)) 'you)) 849 | '_.2) 850 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 851 | (absento (closure _.2))) 852 | (((lambda (_.0) ((lambda (_.1) (list _.1 'love 'you)) 'I)) 853 | '_.2) 854 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 855 | (absento (closure _.2))) 856 | ((list ((lambda (_.0) 'I) '_.1) ((lambda (_.2) _.2) 'love) 857 | ((lambda (_.3) 'you) '_.4)) 858 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.3 closure))) 859 | (sym _.0 _.2 _.3) (absento (closure _.1) (closure _.4))) 860 | ((list ((lambda (_.0) 'I) '_.1) 'love 861 | ((lambda (_.2) ((lambda (_.3) 'you) '_.4)) '_.5)) 862 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.3 closure))) 863 | (sym _.0 _.2 _.3) 864 | (absento (closure _.1) (closure _.4) (closure _.5))) 865 | (((lambda (_.0) '(I love you)) (list (list))) 866 | (=/= ((_.0 closure))) (sym _.0)) 867 | ((list 'I ((lambda (_.0) 'love) (list)) 868 | ((lambda (_.1) 'you) '_.2)) 869 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 870 | (absento (closure _.2))) 871 | ((list 'I ((lambda (_.0) _.0) 'love) 872 | ((lambda (_.1) 'you) (lambda (_.2) _.3))) 873 | (=/= ((_.0 closure)) ((_.1 closure)) ((_.2 closure))) 874 | (sym _.0 _.1 _.2) (absento (closure _.3))) 875 | ((list ((lambda (_.0) _.0) 'I) ((lambda (_.1) 'love) '_.2) 876 | ((lambda (_.3) 'you) '_.4)) 877 | (=/= ((_.0 closure)) ((_.1 closure)) ((_.3 closure))) 878 | (sym _.0 _.1 _.3) (absento (closure _.2) (closure _.4))) 879 | (((lambda (_.0) (list ((lambda (_.1) 'I) '_.2) _.0 'you)) 880 | 'love) 881 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 882 | (absento (closure _.2))) 883 | ((list 'I ((lambda (_.0) 'love) '_.1) 884 | ((lambda (_.2) ((lambda (_.3) 'you) '_.4)) '_.5)) 885 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.3 closure))) 886 | (sym _.0 _.2 _.3) 887 | (absento (closure _.1) (closure _.4) (closure _.5))) 888 | (((lambda (_.0) ((lambda (_.1) (list 'I 'love 'you)) _.0)) '_.2) 889 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 890 | (absento (closure _.2))) 891 | ((list ((lambda (_.0) 'I) '_.1) 892 | ((lambda (_.2) 'love) '_.3) 893 | ((lambda (_.4) 'you) (lambda (_.5) _.6))) 894 | (=/= ((_.0 closure)) ((_.2 closure)) ((_.4 closure)) 895 | ((_.5 closure))) 896 | (sym _.0 _.2 _.4 _.5) 897 | (absento (closure _.1) (closure _.3) (closure _.6))) 898 | (((lambda (_.0) ((lambda (_.1) (list 'I _.1 'you)) 'love)) '_.2) 899 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 900 | (absento (closure _.2))) 901 | (((lambda (_.0) (list 'I 'love ((lambda (_.1) _.1) 'you))) '_.2) 902 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1) 903 | (absento (closure _.2))) 904 | ((list ((lambda (_.0) 'I) (list)) 'love 905 | ((lambda (_.1) _.1) 'you)) 906 | (=/= ((_.0 closure)) ((_.1 closure))) (sym _.0 _.1)))) 907 | 908 | 909 | ;; 1 collection 910 | ;; 788 ms elapsed cpu time, including 0 ms collecting 911 | ;; 792 ms elapsed real time, including 0 ms collecting 912 | ;; 10150592 bytes allocated 913 | (test "Scheme-interpreter-list-quine-0" 914 | (run 1 (q) 915 | (== '((lambda (_.0) (list _.0 (list 'quote _.0))) 916 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 917 | q) 918 | (eval-expo 919 | `(letrec ((eval-expr 920 | (lambda (expr env) 921 | (match expr 922 | [`(quote ,datum) datum] 923 | [(? symbol? x) (env x)] 924 | [`(list . ,e*) 925 | (map (lambda (e) (eval-expr e env)) e*)] 926 | [`(lambda (,(? symbol? x)) ,body) 927 | (lambda (a) 928 | (eval-expr body (lambda (y) 929 | (if (equal? x y) 930 | a 931 | (env y)))))] 932 | [`(,rator ,rand) 933 | ((eval-expr rator env) (eval-expr rand env))])))) 934 | (eval-expr ',q 935 | (lambda (y) ((lambda (z) z))))) 936 | '() 937 | q)) 938 | '(((lambda (_.0) (list _.0 (list 'quote _.0))) 939 | '(lambda (_.0) (list _.0 (list 'quote _.0)))))) 940 | 941 | ;; 84 collections 942 | ;; 33214 ms elapsed cpu time, including 181 ms collecting 943 | ;; 33253 ms elapsed real time, including 182 ms collecting 944 | ;; 701188960 bytes allocated 945 | (test "Scheme-interpreter-list-quine-1" 946 | (run 1 (q) 947 | (eval-expo 948 | `(letrec ((eval-expr 949 | (lambda (expr env) 950 | (match expr 951 | [`(quote ,datum) datum] 952 | [(? symbol? x) (env x)] 953 | [`(list . ,e*) 954 | (map (lambda (e) (eval-expr e env)) e*)] 955 | [`(lambda (,(? symbol? x)) ,body) 956 | (lambda (a) 957 | (eval-expr body (lambda (y) 958 | (if (equal? x y) 959 | a 960 | (env y)))))] 961 | [`(,rator ,rand) 962 | ((eval-expr rator env) (eval-expr rand env))])))) 963 | (eval-expr ',q 964 | (lambda (y) ((lambda (z) z))))) 965 | '() 966 | q)) 967 | '((((lambda (_.0) (list _.0 (list 'quote _.0))) 968 | '(lambda (_.0) (list _.0 (list 'quote _.0)))) 969 | (=/= ((_.0 closure))) (sym _.0)))) 970 | -------------------------------------------------------------------------------- /variadic-lambda-with-or-tests.scm: -------------------------------------------------------------------------------- 1 | (load "interp-with-variadic-lambda-and-or-and-match.scm") 2 | (load "mk/test-check.scm") 3 | (load "mk/matche.scm") 4 | 5 | ;; We use the relational Racket interpreter, extended to support 'and' 6 | ;; and 'or', to allow us to write a simple proof checker for 7 | ;; propositional logic as a Racket function. Because we can treat the 8 | ;; Racket function as a relation, this proof *checker* can act as a 9 | ;; theorem prover, finding a proof tree to prove a theorem. 10 | 11 | ;; The simple proof checker and proof example are from Matt Might. 12 | 13 | 14 | 15 | ;; The proof checker uses 'and', so we have added both 'and' and 'or' 16 | ;; to the relational interpreter. We can't just add 'and' as a helper 17 | ;; function, as we do with 'member?', since 'and' uses short-circuit 18 | ;; evaluation. 19 | 20 | ;; Let's test 'and' and 'or': 21 | 22 | ;; and tests 23 | (test "and-0" 24 | (run* (q) (eval-expo '(and) '() q)) 25 | '(#t)) 26 | 27 | (test "and-1" 28 | (run* (q) (eval-expo '(and 5) '() q)) 29 | '(5)) 30 | 31 | (test "and-2" 32 | (run* (q) (eval-expo '(and #f) '() q)) 33 | '(#f)) 34 | 35 | (test "and-3" 36 | (run* (q) (eval-expo '(and 5 6) '() q)) 37 | '(6)) 38 | 39 | (test "and-4" 40 | (run* (q) (eval-expo '(and #f 6) '() q)) 41 | '(#f)) 42 | 43 | (test "and-5" 44 | (run* (q) (eval-expo '(and (null? '()) 6) '() q)) 45 | '(6)) 46 | 47 | (test "and-6" 48 | (run* (q) (eval-expo '(and (null? '(a b c)) 6) '() q)) 49 | '(#f)) 50 | 51 | 52 | ;; or tests 53 | (test "or-0" 54 | (run* (q) (eval-expo '(or) '() q)) 55 | '(#f)) 56 | 57 | (test "or-1" 58 | (run* (q) (eval-expo '(or 5) '() q)) 59 | '(5)) 60 | 61 | (test "or-2" 62 | (run* (q) (eval-expo '(or #f) '() q)) 63 | '(#f)) 64 | 65 | (test "or-3" 66 | (run* (q) (eval-expo '(or 5 6) '() q)) 67 | '(5)) 68 | 69 | (test "or-4" 70 | (run* (q) (eval-expo '(or #f 6) '() q)) 71 | '(6)) 72 | 73 | (test "or-5" 74 | (run* (q) (eval-expo '(or (null? '()) 6) '() q)) 75 | '(#t)) 76 | 77 | (test "or-6" 78 | (run* (q) (eval-expo '(or (null? '(a b c)) 6) '() q)) 79 | '(6)) 80 | 81 | 82 | ;; We now port Matt Might's proof checker to use the subset of Racket 83 | ;; supported by our relational interpreter. Our example problem is 84 | ;; also from Matt. 85 | ;; 86 | ;; Matt's minimalist proof checker for propositional logic: 87 | 88 | #| 89 | (define (proof? proof) 90 | (match proof 91 | ((assumption ,assms () ,A) (member? A assms)) 92 | ((modus-ponens 93 | ,assms (,(and ant1 ‘(,_ ,assms1 ,_ (if ,A ,B))) 94 | ,(and ant2 ‘(,_ ,assms2 ,_ ,C))) ,D) 95 | (and (equal? A C) (equal? B D) 96 | (equal? assms assms1) (equal? assms assms2) 97 | (proof? ant1) 98 | (proof? ant2))))) 99 | |# 100 | 101 | ;; Here is our port of the proof checker to our interpreter. We use 102 | ;; 'letrec' instead of 'define', we define 'member?' as a helper 103 | ;; function, and use Racket's pattern-matching syntax. The resulting 104 | ;; 'letrec' expression runs without modification in Racket, since the 105 | ;; expression does not include any logic variables. 106 | 107 | ;; We are asking the proof checker to check our proof of C, using the 108 | ;; assumptions A, A => B, and B => C. Note that we give the entire 109 | ;; proof tree as the input to 'proof?'. 110 | 111 | ;; 4 collections 112 | ;; 3980 ms elapsed cpu time, including 0 ms collecting 113 | ;; 3985 ms elapsed real time, including 0 ms collecting 114 | ;; 33762080 bytes allocated 115 | (test "proof-1" 116 | (run* (q) 117 | (eval-expo 118 | `(letrec ((member? (lambda (x ls) 119 | (if (null? ls) 120 | #f 121 | (if (equal? (car ls) x) 122 | #t 123 | (member? x (cdr ls))))))) 124 | (letrec ((proof? (lambda (proof) 125 | (match proof 126 | [`(assumption ,assms () ,A) 127 | (member? A assms)] 128 | [`(modus-ponens 129 | ,assms 130 | ((,r1 ,assms ,ants1 (if ,A ,B)) 131 | (,r2 ,assms ,ants2 ,A)) 132 | ,B) 133 | (and (proof? (list r1 assms ants1 (list 'if A B))) 134 | (proof? (list r2 assms ants2 A)))])))) 135 | (proof? '(modus-ponens 136 | (A (if A B) (if B C)) 137 | ((assumption (A (if A B) (if B C)) () (if B C)) 138 | (modus-ponens 139 | (A (if A B) (if B C)) 140 | ((assumption (A (if A B) (if B C)) () (if A B)) 141 | (assumption (A (if A B) (if B C)) () A)) B)) 142 | C)))) 143 | '() 144 | q)) 145 | '(#t)) 146 | 147 | ;; Getting ready to run the proof checker as a theorem prover. To 148 | ;; make sure our query has the right syntactic structure, we unify 149 | ;; 'prf' with the answer. So we are still running the proof checker 150 | ;; "forwards," although we are using logic variables, so this code 151 | ;; doesn't run directly in Racket. 152 | 153 | ;; 3 collections 154 | ;; 3478 ms elapsed cpu time, including 0 ms collecting 155 | ;; 3480 ms elapsed real time, including 0 ms collecting 156 | ;; 23896992 bytes allocated 157 | (test "proof-2a" 158 | (run* (prf) 159 | (fresh (rule assms ants) 160 | (== '(modus-ponens 161 | (A (if A B) (if B C)) 162 | ((assumption (A (if A B) (if B C)) () (if B C)) 163 | (modus-ponens 164 | (A (if A B) (if B C)) 165 | ((assumption (A (if A B) (if B C)) () (if A B)) 166 | (assumption (A (if A B) (if B C)) () A)) B)) 167 | C) 168 | prf) 169 | (eval-expo 170 | `(letrec ((member? (lambda (x ls) 171 | (if (null? ls) 172 | #f 173 | (if (equal? (car ls) x) 174 | #t 175 | (member? x (cdr ls))))))) 176 | (letrec ((proof? (lambda (proof) 177 | (match proof 178 | [`(assumption ,assms () ,A) 179 | (member? A assms)] 180 | [`(modus-ponens 181 | ,assms 182 | ((,r1 ,assms ,ants1 (if ,A ,B)) 183 | (,r2 ,assms ,ants2 ,A)) 184 | ,B) 185 | (and (proof? (list r1 assms ants1 (list 'if A B))) 186 | (proof? (list r2 assms ants2 A)))])))) 187 | (proof? ',prf))) 188 | '() 189 | #t))) 190 | '((modus-ponens (A (if A B) (if B C)) 191 | ((assumption (A (if A B) (if B C)) () (if B C)) 192 | (modus-ponens (A (if A B) (if B C)) 193 | ((assumption (A (if A B) (if B C)) () (if A B)) 194 | (assumption (A (if A B) (if B C)) () A)) 195 | B)) 196 | C))) 197 | 198 | ;; Another test to ensure we are instantiating 'prf' and 'assms' to 199 | ;; the correct terms before we try running the proof checker as a 200 | ;; theorem prover. Once again, this test runs forwards. 201 | 202 | ;; 3 collections 203 | ;; 3352 ms elapsed cpu time, including 0 ms collecting 204 | ;; 3356 ms elapsed real time, including 0 ms collecting 205 | ;; 23833552 bytes allocated 206 | (test "proof-2b" 207 | (run* (prf) 208 | (fresh (rule assms ants) 209 | (== `(,rule ,assms ,ants C) prf) 210 | (== `(A (if A B) (if B C)) assms) 211 | (== '(modus-ponens 212 | (A (if A B) (if B C)) 213 | ((assumption (A (if A B) (if B C)) () (if B C)) 214 | (modus-ponens 215 | (A (if A B) (if B C)) 216 | ((assumption (A (if A B) (if B C)) () (if A B)) 217 | (assumption (A (if A B) (if B C)) () A)) B)) 218 | C) 219 | prf) 220 | (eval-expo 221 | `(letrec ((member? (lambda (x ls) 222 | (if (null? ls) 223 | #f 224 | (if (equal? (car ls) x) 225 | #t 226 | (member? x (cdr ls))))))) 227 | (letrec ((proof? (lambda (proof) 228 | (match proof 229 | [`(assumption ,assms () ,A) 230 | (member? A assms)] 231 | [`(modus-ponens 232 | ,assms 233 | ((,r1 ,assms ,ants1 (if ,A ,B)) 234 | (,r2 ,assms ,ants2 ,A)) 235 | ,B) 236 | (and (proof? (list r1 assms ants1 (list 'if A B))) 237 | (proof? (list r2 assms ants2 A)))])))) 238 | (proof? ',prf))) 239 | '() 240 | #t))) 241 | '((modus-ponens (A (if A B) (if B C)) 242 | ((assumption (A (if A B) (if B C)) () (if B C)) 243 | (modus-ponens (A (if A B) (if B C)) 244 | ((assumption (A (if A B) (if B C)) () (if A B)) 245 | (assumption (A (if A B) (if B C)) () A)) 246 | B)) 247 | C))) 248 | 249 | ;; The real test! We are no longer unifying 'prf' with the answer. 250 | ;; The proof checker is now inferring the proof tree for the theorem 251 | ;; we are trying to prove (C) given a set of assumptions (A, A => B, 252 | ;; and B => C). The proof checker *function* is now acting as a 253 | ;; *relation*, which lets us use it as a theorem prover. 254 | 255 | ;; 10 collections 256 | ;; 12273 ms elapsed cpu time, including 1 ms collecting 257 | ;; 12283 ms elapsed real time, including 2 ms collecting 258 | ;; 82533568 bytes allocated 259 | ;; 260 | ;; run 2 seems to diverge 261 | (test "proof-2c" 262 | (run 1 (prf) 263 | (fresh (rule assms ants) 264 | ;; We want to prove that C holds... 265 | (== `(,rule ,assms ,ants C) prf) 266 | ;; ...given the assumptions A, A => B, and B => C. 267 | (== `(A (if A B) (if B C)) assms) 268 | (eval-expo 269 | `(letrec ((member? (lambda (x ls) 270 | (if (null? ls) 271 | #f 272 | (if (equal? (car ls) x) 273 | #t 274 | (member? x (cdr ls))))))) 275 | (letrec ((proof? (lambda (proof) 276 | (match proof 277 | [`(assumption ,assms () ,A) 278 | (member? A assms)] 279 | [`(modus-ponens 280 | ,assms 281 | ((,r1 ,assms ,ants1 (if ,A ,B)) 282 | (,r2 ,assms ,ants2 ,A)) 283 | ,B) 284 | (and (proof? (list r1 assms ants1 (list 'if A B))) 285 | (proof? (list r2 assms ants2 A)))])))) 286 | (proof? ',prf))) 287 | '() 288 | #t))) 289 | '((modus-ponens (A (if A B) (if B C)) 290 | ((assumption (A (if A B) (if B C)) () (if B C)) 291 | (modus-ponens (A (if A B) (if B C)) 292 | ((assumption (A (if A B) (if B C)) () (if A B)) 293 | (assumption (A (if A B) (if B C)) () A)) 294 | B)) 295 | C))) 296 | 297 | ;; Here we run the proof checker/theorem prover with a fresh logic variable 298 | ;; representing the proof tree. This allows us to generate valid 299 | ;; proof trees, where each proof tree contains a theorem and the 300 | ;; assumptions used to prove that theorem. 301 | ;; 302 | ;; From the answers it is clear the prover tends to generate "proofs 303 | ;; by assumption", assuming the theorem to be proved. This isn't 304 | ;; surprising, since such proofs require relatively little 305 | ;; computation. A couple of the proof trees do use modus ponens, 306 | ;; however. 307 | ;; 308 | ;; 18 collections 309 | ;; 45118 ms elapsed cpu time, including 3 ms collecting 310 | ;; 45137 ms elapsed real time, including 4 ms collecting 311 | ;; 150564400 bytes allocated 312 | (test "generate-theorems/proofs" 313 | (run 20 (prf) 314 | (eval-expo 315 | `(letrec ((member? (lambda (x ls) 316 | (if (null? ls) 317 | #f 318 | (if (equal? (car ls) x) 319 | #t 320 | (member? x (cdr ls))))))) 321 | (letrec ((proof? (lambda (proof) 322 | (match proof 323 | [`(assumption ,assms () ,A) 324 | (member? A assms)] 325 | [`(modus-ponens 326 | ,assms 327 | ((,r1 ,assms ,ants1 (if ,A ,B)) 328 | (,r2 ,assms ,ants2 ,A)) 329 | ,B) 330 | (and (proof? (list r1 assms ants1 (list 'if A B))) 331 | (proof? (list r2 assms ants2 A)))])))) 332 | (proof? ',prf))) 333 | '() 334 | #t)) 335 | '(((assumption (_.0 . _.1) () _.0) 336 | (absento (closure _.0) (closure _.1))) 337 | ((assumption (_.0 _.1 . _.2) () _.1) (=/= ((_.0 _.1))) 338 | (absento (closure _.0) (closure _.1) (closure _.2))) 339 | ((assumption (_.0 _.1 _.2 . _.3) () _.2) 340 | (=/= ((_.0 _.2)) ((_.1 _.2))) 341 | (absento (closure _.0) (closure _.1) (closure _.2) (closure _.3))) 342 | ((assumption (_.0 _.1 _.2 _.3 . _.4) () _.3) 343 | (=/= ((_.0 _.3)) ((_.1 _.3)) ((_.2 _.3))) 344 | (absento (closure _.0) (closure _.1) (closure _.2) 345 | (closure _.3) (closure _.4))) 346 | ((assumption (_.0 _.1 _.2 _.3 _.4 . _.5) () _.4) 347 | (=/= ((_.0 _.4)) ((_.1 _.4)) ((_.2 _.4)) ((_.3 _.4))) 348 | (absento (closure _.0) (closure _.1) (closure _.2) 349 | (closure _.3) (closure _.4) (closure _.5))) 350 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 . _.6) () _.5) 351 | (=/= ((_.0 _.5)) ((_.1 _.5)) ((_.2 _.5)) ((_.3 _.5)) 352 | ((_.4 _.5))) 353 | (absento (closure _.0) (closure _.1) (closure _.2) 354 | (closure _.3) (closure _.4) (closure _.5) 355 | (closure _.6))) 356 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 . _.7) () _.6) 357 | (=/= ((_.0 _.6)) ((_.1 _.6)) ((_.2 _.6)) ((_.3 _.6)) 358 | ((_.4 _.6)) ((_.5 _.6))) 359 | (absento (closure _.0) (closure _.1) (closure _.2) 360 | (closure _.3) (closure _.4) (closure _.5) 361 | (closure _.6) (closure _.7))) 362 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 . _.8) () _.7) 363 | (=/= ((_.0 _.7)) ((_.1 _.7)) ((_.2 _.7)) ((_.3 _.7)) 364 | ((_.4 _.7)) ((_.5 _.7)) ((_.6 _.7))) 365 | (absento (closure _.0) (closure _.1) (closure _.2) 366 | (closure _.3) (closure _.4) (closure _.5) 367 | (closure _.6) (closure _.7) (closure _.8))) 368 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 . _.9) () _.8) 369 | (=/= ((_.0 _.8)) ((_.1 _.8)) ((_.2 _.8)) ((_.3 _.8)) 370 | ((_.4 _.8)) ((_.5 _.8)) ((_.6 _.8)) ((_.7 _.8))) 371 | (absento (closure _.0) (closure _.1) (closure _.2) 372 | (closure _.3) (closure _.4) (closure _.5) 373 | (closure _.6) (closure _.7) (closure _.8) 374 | (closure _.9))) 375 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 . _.10) () _.9) 376 | (=/= ((_.0 _.9)) ((_.1 _.9)) ((_.2 _.9)) ((_.3 _.9)) 377 | ((_.4 _.9)) ((_.5 _.9)) ((_.6 _.9)) ((_.7 _.9)) 378 | ((_.8 _.9))) 379 | (absento (closure _.0) (closure _.1) (closure _.10) 380 | (closure _.2) (closure _.3) (closure _.4) 381 | (closure _.5) (closure _.6) (closure _.7) 382 | (closure _.8) (closure _.9))) 383 | ((assumption 384 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 . _.11) 385 | () _.10) 386 | (=/= ((_.0 _.10)) ((_.1 _.10)) ((_.10 _.2)) ((_.10 _.3)) 387 | ((_.10 _.4)) ((_.10 _.5)) ((_.10 _.6)) ((_.10 _.7)) 388 | ((_.10 _.8)) ((_.10 _.9))) 389 | (absento (closure _.0) (closure _.1) (closure _.10) 390 | (closure _.11) (closure _.2) (closure _.3) 391 | (closure _.4) (closure _.5) (closure _.6) 392 | (closure _.7) (closure _.8) (closure _.9))) 393 | ((assumption 394 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 . _.12) 395 | () _.11) 396 | (=/= ((_.0 _.11)) ((_.1 _.11)) ((_.10 _.11)) 397 | ((_.11 _.2)) ((_.11 _.3)) ((_.11 _.4)) ((_.11 _.5)) 398 | ((_.11 _.6)) ((_.11 _.7)) ((_.11 _.8)) ((_.11 _.9))) 399 | (absento (closure _.0) (closure _.1) (closure _.10) 400 | (closure _.11) (closure _.12) (closure _.2) 401 | (closure _.3) (closure _.4) (closure _.5) 402 | (closure _.6) (closure _.7) (closure _.8) 403 | (closure _.9))) 404 | ((assumption 405 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 . _.13) 406 | () _.12) 407 | (=/= ((_.0 _.12)) ((_.1 _.12)) ((_.10 _.12)) 408 | ((_.11 _.12)) ((_.12 _.2)) ((_.12 _.3)) ((_.12 _.4)) 409 | ((_.12 _.5)) ((_.12 _.6)) ((_.12 _.7)) ((_.12 _.8)) 410 | ((_.12 _.9))) 411 | (absento (closure _.0) (closure _.1) (closure _.10) 412 | (closure _.11) (closure _.12) (closure _.13) 413 | (closure _.2) (closure _.3) (closure _.4) 414 | (closure _.5) (closure _.6) (closure _.7) 415 | (closure _.8) (closure _.9))) 416 | ((assumption 417 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 _.13 . _.14) 418 | () _.13) 419 | (=/= ((_.0 _.13)) ((_.1 _.13)) ((_.10 _.13)) 420 | ((_.11 _.13)) ((_.12 _.13)) ((_.13 _.2)) ((_.13 _.3)) 421 | ((_.13 _.4)) ((_.13 _.5)) ((_.13 _.6)) ((_.13 _.7)) 422 | ((_.13 _.8)) ((_.13 _.9))) 423 | (absento (closure _.0) (closure _.1) (closure _.10) 424 | (closure _.11) (closure _.12) (closure _.13) 425 | (closure _.14) (closure _.2) (closure _.3) 426 | (closure _.4) (closure _.5) (closure _.6) 427 | (closure _.7) (closure _.8) (closure _.9))) 428 | ((modus-ponens ((if _.0 _.1) _.0 . _.2) 429 | ((assumption ((if _.0 _.1) _.0 . _.2) () (if _.0 _.1)) 430 | (assumption ((if _.0 _.1) _.0 . _.2) () _.0)) 431 | _.1) 432 | (absento (closure _.0) (closure _.1) (closure _.2))) 433 | ((assumption 434 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 435 | _.13 _.14 . _.15) 436 | () _.14) 437 | (=/= ((_.0 _.14)) ((_.1 _.14)) ((_.10 _.14)) 438 | ((_.11 _.14)) ((_.12 _.14)) ((_.13 _.14)) ((_.14 _.2)) 439 | ((_.14 _.3)) ((_.14 _.4)) ((_.14 _.5)) ((_.14 _.6)) 440 | ((_.14 _.7)) ((_.14 _.8)) ((_.14 _.9))) 441 | (absento (closure _.0) (closure _.1) (closure _.10) 442 | (closure _.11) (closure _.12) (closure _.13) 443 | (closure _.14) (closure _.15) (closure _.2) 444 | (closure _.3) (closure _.4) (closure _.5) 445 | (closure _.6) (closure _.7) (closure _.8) 446 | (closure _.9))) 447 | ((assumption 448 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 449 | _.13 _.14 _.15 . _.16) 450 | () _.15) 451 | (=/= ((_.0 _.15)) ((_.1 _.15)) ((_.10 _.15)) 452 | ((_.11 _.15)) ((_.12 _.15)) ((_.13 _.15)) 453 | ((_.14 _.15)) ((_.15 _.2)) ((_.15 _.3)) ((_.15 _.4)) 454 | ((_.15 _.5)) ((_.15 _.6)) ((_.15 _.7)) ((_.15 _.8)) 455 | ((_.15 _.9))) 456 | (absento (closure _.0) (closure _.1) (closure _.10) 457 | (closure _.11) (closure _.12) (closure _.13) 458 | (closure _.14) (closure _.15) (closure _.16) 459 | (closure _.2) (closure _.3) (closure _.4) 460 | (closure _.5) (closure _.6) (closure _.7) 461 | (closure _.8) (closure _.9))) 462 | ((assumption 463 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 464 | _.13 _.14 _.15 _.16 . _.17) 465 | () _.16) 466 | (=/= ((_.0 _.16)) ((_.1 _.16)) ((_.10 _.16)) 467 | ((_.11 _.16)) ((_.12 _.16)) ((_.13 _.16)) 468 | ((_.14 _.16)) ((_.15 _.16)) ((_.16 _.2)) ((_.16 _.3)) 469 | ((_.16 _.4)) ((_.16 _.5)) ((_.16 _.6)) ((_.16 _.7)) 470 | ((_.16 _.8)) ((_.16 _.9))) 471 | (absento (closure _.0) (closure _.1) (closure _.10) 472 | (closure _.11) (closure _.12) (closure _.13) 473 | (closure _.14) (closure _.15) (closure _.16) 474 | (closure _.17) (closure _.2) (closure _.3) 475 | (closure _.4) (closure _.5) (closure _.6) 476 | (closure _.7) (closure _.8) (closure _.9))) 477 | ((assumption 478 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 479 | _.13 _.14 _.15 _.16 _.17 . _.18) 480 | () _.17) 481 | (=/= ((_.0 _.17)) ((_.1 _.17)) ((_.10 _.17)) 482 | ((_.11 _.17)) ((_.12 _.17)) ((_.13 _.17)) 483 | ((_.14 _.17)) ((_.15 _.17)) ((_.16 _.17)) ((_.17 _.2)) 484 | ((_.17 _.3)) ((_.17 _.4)) ((_.17 _.5)) ((_.17 _.6)) 485 | ((_.17 _.7)) ((_.17 _.8)) ((_.17 _.9))) 486 | (absento (closure _.0) (closure _.1) (closure _.10) 487 | (closure _.11) (closure _.12) (closure _.13) 488 | (closure _.14) (closure _.15) (closure _.16) 489 | (closure _.17) (closure _.18) (closure _.2) 490 | (closure _.3) (closure _.4) (closure _.5) 491 | (closure _.6) (closure _.7) (closure _.8) 492 | (closure _.9))) 493 | ((modus-ponens ((if _.0 _.1) _.2 _.0 . _.3) 494 | ((assumption ((if _.0 _.1) _.2 _.0 . _.3) () 495 | (if _.0 _.1)) 496 | (assumption ((if _.0 _.1) _.2 _.0 . _.3) () _.0)) 497 | _.1) 498 | (=/= ((_.0 _.2))) 499 | (absento (closure _.0) (closure _.1) (closure _.2) 500 | (closure _.3))))) 501 | 502 | 503 | ;; Since the proof checker/theorem prover tends to generate trivial 504 | ;; proof trees that just assume the theorem to be proved, lets 505 | ;; restrict the outer proof rule to be modus ponens. 506 | ;; 507 | ;; 27 collections 508 | ;; 84672 ms elapsed cpu time, including 7 ms collecting 509 | ;; 84794 ms elapsed real time, including 7 ms collecting 510 | ;; 226336768 bytes allocated 511 | (test "generate-theorems/proofs-using-modus-ponens" 512 | (run 20 (prf) 513 | (fresh (assms ants conseq) 514 | (== `(modus-ponens ,assms ,ants ,conseq) prf) 515 | (eval-expo 516 | `(letrec ((member? (lambda (x ls) 517 | (if (null? ls) 518 | #f 519 | (if (equal? (car ls) x) 520 | #t 521 | (member? x (cdr ls))))))) 522 | (letrec ((proof? (lambda (proof) 523 | (match proof 524 | [`(assumption ,assms () ,A) 525 | (member? A assms)] 526 | [`(modus-ponens 527 | ,assms 528 | ((,r1 ,assms ,ants1 (if ,A ,B)) 529 | (,r2 ,assms ,ants2 ,A)) 530 | ,B) 531 | (and (proof? (list r1 assms ants1 (list 'if A B))) 532 | (proof? (list r2 assms ants2 A)))])))) 533 | (proof? ',prf))) 534 | '() 535 | #t))) 536 | '(((modus-ponens ((if _.0 _.1) _.0 . _.2) 537 | ((assumption ((if _.0 _.1) _.0 . _.2) () (if _.0 _.1)) 538 | (assumption ((if _.0 _.1) _.0 . _.2) () _.0)) 539 | _.1) 540 | (absento (closure _.0) (closure _.1) (closure _.2))) 541 | ((modus-ponens ((if _.0 _.1) _.2 _.0 . _.3) 542 | ((assumption ((if _.0 _.1) _.2 _.0 . _.3) () 543 | (if _.0 _.1)) 544 | (assumption ((if _.0 _.1) _.2 _.0 . _.3) () _.0)) 545 | _.1) 546 | (=/= ((_.0 _.2))) 547 | (absento (closure _.0) (closure _.1) (closure _.2) 548 | (closure _.3))) 549 | ((modus-ponens (_.0 (if _.0 _.1) . _.2) 550 | ((assumption (_.0 (if _.0 _.1) . _.2) () (if _.0 _.1)) 551 | (assumption (_.0 (if _.0 _.1) . _.2) () _.0)) 552 | _.1) 553 | (absento (closure _.0) (closure _.1) (closure _.2))) 554 | ((modus-ponens ((if _.0 _.1) _.2 _.3 _.0 . _.4) 555 | ((assumption ((if _.0 _.1) _.2 _.3 _.0 . _.4) () 556 | (if _.0 _.1)) 557 | (assumption ((if _.0 _.1) _.2 _.3 _.0 . _.4) () _.0)) 558 | _.1) 559 | (=/= ((_.0 _.2)) ((_.0 _.3))) 560 | (absento (closure _.0) (closure _.1) (closure _.2) 561 | (closure _.3) (closure _.4))) 562 | ((modus-ponens ((if _.0 _.1) _.2 _.3 _.4 _.0 . _.5) 563 | ((assumption ((if _.0 _.1) _.2 _.3 _.4 _.0 . _.5) () 564 | (if _.0 _.1)) 565 | (assumption ((if _.0 _.1) _.2 _.3 _.4 _.0 . _.5) () 566 | _.0)) 567 | _.1) 568 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4))) 569 | (absento (closure _.0) (closure _.1) (closure _.2) 570 | (closure _.3) (closure _.4) (closure _.5))) 571 | ((modus-ponens ((if _.0 _.1) _.2 _.3 _.4 _.5 _.0 . _.6) 572 | ((assumption ((if _.0 _.1) _.2 _.3 _.4 _.5 _.0 . _.6) 573 | () (if _.0 _.1)) 574 | (assumption ((if _.0 _.1) _.2 _.3 _.4 _.5 _.0 . _.6) 575 | () _.0)) 576 | _.1) 577 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5))) 578 | (absento (closure _.0) (closure _.1) (closure _.2) 579 | (closure _.3) (closure _.4) (closure _.5) 580 | (closure _.6))) 581 | ((modus-ponens 582 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.0 . _.7) 583 | ((assumption 584 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.0 . _.7) () 585 | (if _.0 _.1)) 586 | (assumption 587 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.0 . _.7) () _.0)) 588 | _.1) 589 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 590 | ((_.0 _.6))) 591 | (absento (closure _.0) (closure _.1) (closure _.2) 592 | (closure _.3) (closure _.4) (closure _.5) 593 | (closure _.6) (closure _.7))) 594 | ((modus-ponens (_.0 (if _.1 _.2) _.1 . _.3) 595 | ((assumption (_.0 (if _.1 _.2) _.1 . _.3) () 596 | (if _.1 _.2)) 597 | (assumption (_.0 (if _.1 _.2) _.1 . _.3) () _.1)) 598 | _.2) 599 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2)))) 600 | (absento (closure _.0) (closure _.1) (closure _.2) 601 | (closure _.3))) 602 | ((modus-ponens (_.0 _.1 (if _.0 _.2) . _.3) 603 | ((assumption (_.0 _.1 (if _.0 _.2) . _.3) () 604 | (if _.0 _.2)) 605 | (assumption (_.0 _.1 (if _.0 _.2) . _.3) () _.0)) 606 | _.2) 607 | (=/= ((_.1 (if _.0 _.2)))) 608 | (absento (closure _.0) (closure _.1) (closure _.2) 609 | (closure _.3))) 610 | ((modus-ponens 611 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.0 . _.8) 612 | ((assumption 613 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.0 . _.8) () 614 | (if _.0 _.1)) 615 | (assumption 616 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.0 . _.8) () 617 | _.0)) 618 | _.1) 619 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 620 | ((_.0 _.6)) ((_.0 _.7))) 621 | (absento (closure _.0) (closure _.1) (closure _.2) 622 | (closure _.3) (closure _.4) (closure _.5) 623 | (closure _.6) (closure _.7) (closure _.8))) 624 | ((modus-ponens 625 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.0 . _.9) 626 | ((assumption 627 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.0 . _.9) 628 | () (if _.0 _.1)) 629 | (assumption 630 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.0 631 | . _.9) 632 | () _.0)) 633 | _.1) 634 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 635 | ((_.0 _.6)) ((_.0 _.7)) ((_.0 _.8))) 636 | (absento (closure _.0) (closure _.1) (closure _.2) 637 | (closure _.3) (closure _.4) (closure _.5) 638 | (closure _.6) (closure _.7) (closure _.8) 639 | (closure _.9))) 640 | ((modus-ponens (_.0 (if _.1 _.2) _.3 _.1 . _.4) 641 | ((assumption (_.0 (if _.1 _.2) _.3 _.1 . _.4) () 642 | (if _.1 _.2)) 643 | (assumption (_.0 (if _.1 _.2) _.3 _.1 . _.4) () _.1)) 644 | _.2) 645 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2))) ((_.1 _.3))) 646 | (absento (closure _.0) (closure _.1) (closure _.2) 647 | (closure _.3) (closure _.4))) 648 | ((modus-ponens 649 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.0 650 | . _.10) 651 | ((assumption 652 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.0 653 | . _.10) 654 | () (if _.0 _.1)) 655 | (assumption 656 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.0 657 | . _.10) 658 | () _.0)) 659 | _.1) 660 | (=/= ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) 661 | ((_.0 _.6)) ((_.0 _.7)) ((_.0 _.8)) ((_.0 _.9))) 662 | (absento (closure _.0) (closure _.1) (closure _.10) 663 | (closure _.2) (closure _.3) (closure _.4) 664 | (closure _.5) (closure _.6) (closure _.7) 665 | (closure _.8) (closure _.9))) 666 | ((modus-ponens 667 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.0 668 | . _.11) 669 | ((assumption 670 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 671 | _.0 . _.11) 672 | () (if _.0 _.1)) 673 | (assumption 674 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 675 | _.0 . _.11) 676 | () _.0)) 677 | _.1) 678 | (=/= ((_.0 _.10)) ((_.0 _.2)) ((_.0 _.3)) ((_.0 _.4)) 679 | ((_.0 _.5)) ((_.0 _.6)) ((_.0 _.7)) ((_.0 _.8)) 680 | ((_.0 _.9))) 681 | (absento (closure _.0) (closure _.1) (closure _.10) 682 | (closure _.11) (closure _.2) (closure _.3) 683 | (closure _.4) (closure _.5) (closure _.6) 684 | (closure _.7) (closure _.8) (closure _.9))) 685 | ((modus-ponens (_.0 (if _.1 _.2) _.3 _.4 _.1 . _.5) 686 | ((assumption (_.0 (if _.1 _.2) _.3 _.4 _.1 . _.5) () 687 | (if _.1 _.2)) 688 | (assumption (_.0 (if _.1 _.2) _.3 _.4 _.1 . _.5) () 689 | _.1)) 690 | _.2) 691 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2))) ((_.1 _.3)) 692 | ((_.1 _.4))) 693 | (absento (closure _.0) (closure _.1) (closure _.2) 694 | (closure _.3) (closure _.4) (closure _.5))) 695 | ((modus-ponens (_.0 _.1 (if _.1 _.2) . _.3) 696 | ((assumption (_.0 _.1 (if _.1 _.2) . _.3) () 697 | (if _.1 _.2)) 698 | (assumption (_.0 _.1 (if _.1 _.2) . _.3) () _.1)) 699 | _.2) 700 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2)))) 701 | (absento (closure _.0) (closure _.1) (closure _.2) 702 | (closure _.3))) 703 | ((modus-ponens 704 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 705 | _.0 . _.12) 706 | ((assumption 707 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 708 | _.11 _.0 . _.12) 709 | () (if _.0 _.1)) 710 | (assumption 711 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 712 | _.11 _.0 . _.12) 713 | () _.0)) 714 | _.1) 715 | (=/= ((_.0 _.10)) ((_.0 _.11)) ((_.0 _.2)) ((_.0 _.3)) 716 | ((_.0 _.4)) ((_.0 _.5)) ((_.0 _.6)) ((_.0 _.7)) 717 | ((_.0 _.8)) ((_.0 _.9))) 718 | (absento (closure _.0) (closure _.1) (closure _.10) 719 | (closure _.11) (closure _.12) (closure _.2) 720 | (closure _.3) (closure _.4) (closure _.5) 721 | (closure _.6) (closure _.7) (closure _.8) 722 | (closure _.9))) 723 | ((modus-ponens 724 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 725 | _.12 _.0 . _.13) 726 | ((assumption 727 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 728 | _.11 _.12 _.0 . _.13) 729 | () (if _.0 _.1)) 730 | (assumption 731 | ((if _.0 _.1) _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 732 | _.11 _.12 _.0 . _.13) 733 | () _.0)) 734 | _.1) 735 | (=/= ((_.0 _.10)) ((_.0 _.11)) ((_.0 _.12)) ((_.0 _.2)) 736 | ((_.0 _.3)) ((_.0 _.4)) ((_.0 _.5)) ((_.0 _.6)) 737 | ((_.0 _.7)) ((_.0 _.8)) ((_.0 _.9))) 738 | (absento (closure _.0) (closure _.1) (closure _.10) 739 | (closure _.11) (closure _.12) (closure _.13) 740 | (closure _.2) (closure _.3) (closure _.4) 741 | (closure _.5) (closure _.6) (closure _.7) 742 | (closure _.8) (closure _.9))) 743 | ((modus-ponens (_.0 (if _.1 _.2) _.3 _.4 _.5 _.1 . _.6) 744 | ((assumption (_.0 (if _.1 _.2) _.3 _.4 _.5 _.1 . _.6) 745 | () (if _.1 _.2)) 746 | (assumption (_.0 (if _.1 _.2) _.3 _.4 _.5 _.1 . _.6) 747 | () _.1)) 748 | _.2) 749 | (=/= ((_.0 _.1)) ((_.0 (if _.1 _.2))) ((_.1 _.3)) 750 | ((_.1 _.4)) ((_.1 _.5))) 751 | (absento (closure _.0) (closure _.1) (closure _.2) 752 | (closure _.3) (closure _.4) (closure _.5) 753 | (closure _.6))) 754 | ((modus-ponens ((if _.0 _.0) _.0 . _.1) 755 | ((assumption ((if _.0 _.0) _.0 . _.1) () (if _.0 _.0)) 756 | (modus-ponens ((if _.0 _.0) _.0 . _.1) 757 | ((assumption ((if _.0 _.0) _.0 . _.1) () 758 | (if _.0 _.0)) 759 | (assumption ((if _.0 _.0) _.0 . _.1) () _.0)) 760 | _.0)) 761 | _.0) 762 | (absento (closure _.0) (closure _.1))))) 763 | 764 | ;; Here we generate *incorrect* proof trees. That is, proof trees 765 | ;; that *do not* prove the theorem from the given set of assumptions. 766 | ;; We do this simply by changing the last argument of 'eval-expo' to 767 | ;; #f instead of #t. In other words, we are inferring proofs for 768 | ;; which the 'proof?' function in Racket would return #f. 769 | 770 | ;; 15 collections 771 | ;; 29688 ms elapsed cpu time, including 2 ms collecting 772 | ;; 29691 ms elapsed real time, including 2 ms collecting 773 | ;; 120117040 bytes allocated 774 | (test "generate-non-theorems/proofs" 775 | (run 20 (prf) 776 | (eval-expo 777 | `(letrec ((member? (lambda (x ls) 778 | (if (null? ls) 779 | #f 780 | (if (equal? (car ls) x) 781 | #t 782 | (member? x (cdr ls))))))) 783 | (letrec ((proof? (lambda (proof) 784 | (match proof 785 | [`(assumption ,assms () ,A) 786 | (member? A assms)] 787 | [`(modus-ponens 788 | ,assms 789 | ((,r1 ,assms ,ants1 (if ,A ,B)) 790 | (,r2 ,assms ,ants2 ,A)) 791 | ,B) 792 | (and (proof? (list r1 assms ants1 (list 'if A B))) 793 | (proof? (list r2 assms ants2 A)))])))) 794 | (proof? ',prf))) 795 | '() 796 | #f)) 797 | '(((assumption () () _.0) (absento (closure _.0))) 798 | ((assumption (_.0) () _.1) (=/= ((_.0 _.1))) 799 | (absento (closure _.0) (closure _.1))) 800 | ((assumption (_.0 _.1) () _.2) 801 | (=/= ((_.0 _.2)) ((_.1 _.2))) 802 | (absento (closure _.0) (closure _.1) (closure _.2))) 803 | ((assumption (_.0 _.1 _.2) () _.3) 804 | (=/= ((_.0 _.3)) ((_.1 _.3)) ((_.2 _.3))) 805 | (absento (closure _.0) (closure _.1) (closure _.2) 806 | (closure _.3))) 807 | ((assumption (_.0 _.1 _.2 _.3) () _.4) 808 | (=/= ((_.0 _.4)) ((_.1 _.4)) ((_.2 _.4)) ((_.3 _.4))) 809 | (absento (closure _.0) (closure _.1) (closure _.2) 810 | (closure _.3) (closure _.4))) 811 | ((assumption (_.0 _.1 _.2 _.3 _.4) () _.5) 812 | (=/= ((_.0 _.5)) ((_.1 _.5)) ((_.2 _.5)) ((_.3 _.5)) 813 | ((_.4 _.5))) 814 | (absento (closure _.0) (closure _.1) (closure _.2) 815 | (closure _.3) (closure _.4) (closure _.5))) 816 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5) () _.6) 817 | (=/= ((_.0 _.6)) ((_.1 _.6)) ((_.2 _.6)) ((_.3 _.6)) 818 | ((_.4 _.6)) ((_.5 _.6))) 819 | (absento (closure _.0) (closure _.1) (closure _.2) 820 | (closure _.3) (closure _.4) (closure _.5) 821 | (closure _.6))) 822 | ((modus-ponens () 823 | ((assumption () () (if _.0 _.1)) (_.2 () _.3 _.0)) _.1) 824 | (absento (closure _.0) (closure _.1) (closure _.2) 825 | (closure _.3))) 826 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6) () _.7) 827 | (=/= ((_.0 _.7)) ((_.1 _.7)) ((_.2 _.7)) ((_.3 _.7)) 828 | ((_.4 _.7)) ((_.5 _.7)) ((_.6 _.7))) 829 | (absento (closure _.0) (closure _.1) (closure _.2) 830 | (closure _.3) (closure _.4) (closure _.5) 831 | (closure _.6) (closure _.7))) 832 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7) () _.8) 833 | (=/= ((_.0 _.8)) ((_.1 _.8)) ((_.2 _.8)) ((_.3 _.8)) 834 | ((_.4 _.8)) ((_.5 _.8)) ((_.6 _.8)) ((_.7 _.8))) 835 | (absento (closure _.0) (closure _.1) (closure _.2) 836 | (closure _.3) (closure _.4) (closure _.5) 837 | (closure _.6) (closure _.7) (closure _.8))) 838 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8) () _.9) 839 | (=/= ((_.0 _.9)) ((_.1 _.9)) ((_.2 _.9)) ((_.3 _.9)) 840 | ((_.4 _.9)) ((_.5 _.9)) ((_.6 _.9)) ((_.7 _.9)) 841 | ((_.8 _.9))) 842 | (absento (closure _.0) (closure _.1) (closure _.2) 843 | (closure _.3) (closure _.4) (closure _.5) 844 | (closure _.6) (closure _.7) (closure _.8) 845 | (closure _.9))) 846 | ((assumption (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9) () 847 | _.10) 848 | (=/= ((_.0 _.10)) ((_.1 _.10)) ((_.10 _.2)) ((_.10 _.3)) 849 | ((_.10 _.4)) ((_.10 _.5)) ((_.10 _.6)) ((_.10 _.7)) 850 | ((_.10 _.8)) ((_.10 _.9))) 851 | (absento (closure _.0) (closure _.1) (closure _.10) 852 | (closure _.2) (closure _.3) (closure _.4) 853 | (closure _.5) (closure _.6) (closure _.7) 854 | (closure _.8) (closure _.9))) 855 | ((modus-ponens (_.0) 856 | ((assumption (_.0) () (if _.1 _.2)) (_.3 (_.0) _.4 _.1)) 857 | _.2) 858 | (=/= ((_.0 (if _.1 _.2)))) 859 | (absento (closure _.0) (closure _.1) (closure _.2) 860 | (closure _.3) (closure _.4))) 861 | ((assumption 862 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10) () _.11) 863 | (=/= ((_.0 _.11)) ((_.1 _.11)) ((_.10 _.11)) 864 | ((_.11 _.2)) ((_.11 _.3)) ((_.11 _.4)) ((_.11 _.5)) 865 | ((_.11 _.6)) ((_.11 _.7)) ((_.11 _.8)) ((_.11 _.9))) 866 | (absento (closure _.0) (closure _.1) (closure _.10) 867 | (closure _.11) (closure _.2) (closure _.3) 868 | (closure _.4) (closure _.5) (closure _.6) 869 | (closure _.7) (closure _.8) (closure _.9))) 870 | ((assumption 871 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11) () 872 | _.12) 873 | (=/= ((_.0 _.12)) ((_.1 _.12)) ((_.10 _.12)) 874 | ((_.11 _.12)) ((_.12 _.2)) ((_.12 _.3)) ((_.12 _.4)) 875 | ((_.12 _.5)) ((_.12 _.6)) ((_.12 _.7)) ((_.12 _.8)) 876 | ((_.12 _.9))) 877 | (absento (closure _.0) (closure _.1) (closure _.10) 878 | (closure _.11) (closure _.12) (closure _.2) 879 | (closure _.3) (closure _.4) (closure _.5) 880 | (closure _.6) (closure _.7) (closure _.8) 881 | (closure _.9))) 882 | ((assumption 883 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12) 884 | () _.13) 885 | (=/= ((_.0 _.13)) ((_.1 _.13)) ((_.10 _.13)) 886 | ((_.11 _.13)) ((_.12 _.13)) ((_.13 _.2)) ((_.13 _.3)) 887 | ((_.13 _.4)) ((_.13 _.5)) ((_.13 _.6)) ((_.13 _.7)) 888 | ((_.13 _.8)) ((_.13 _.9))) 889 | (absento (closure _.0) (closure _.1) (closure _.10) 890 | (closure _.11) (closure _.12) (closure _.13) 891 | (closure _.2) (closure _.3) (closure _.4) 892 | (closure _.5) (closure _.6) (closure _.7) 893 | (closure _.8) (closure _.9))) 894 | ((assumption 895 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 896 | _.13) 897 | () _.14) 898 | (=/= ((_.0 _.14)) ((_.1 _.14)) ((_.10 _.14)) 899 | ((_.11 _.14)) ((_.12 _.14)) ((_.13 _.14)) ((_.14 _.2)) 900 | ((_.14 _.3)) ((_.14 _.4)) ((_.14 _.5)) ((_.14 _.6)) 901 | ((_.14 _.7)) ((_.14 _.8)) ((_.14 _.9))) 902 | (absento (closure _.0) (closure _.1) (closure _.10) 903 | (closure _.11) (closure _.12) (closure _.13) 904 | (closure _.14) (closure _.2) (closure _.3) 905 | (closure _.4) (closure _.5) (closure _.6) 906 | (closure _.7) (closure _.8) (closure _.9))) 907 | ((modus-ponens (_.0 _.1) 908 | ((assumption (_.0 _.1) () (if _.2 _.3)) 909 | (_.4 (_.0 _.1) _.5 _.2)) 910 | _.3) 911 | (=/= ((_.0 (if _.2 _.3))) ((_.1 (if _.2 _.3)))) 912 | (absento (closure _.0) (closure _.1) (closure _.2) 913 | (closure _.3) (closure _.4) (closure _.5))) 914 | ((assumption 915 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 916 | _.13 _.14) 917 | () _.15) 918 | (=/= ((_.0 _.15)) ((_.1 _.15)) ((_.10 _.15)) 919 | ((_.11 _.15)) ((_.12 _.15)) ((_.13 _.15)) 920 | ((_.14 _.15)) ((_.15 _.2)) ((_.15 _.3)) ((_.15 _.4)) 921 | ((_.15 _.5)) ((_.15 _.6)) ((_.15 _.7)) ((_.15 _.8)) 922 | ((_.15 _.9))) 923 | (absento (closure _.0) (closure _.1) (closure _.10) 924 | (closure _.11) (closure _.12) (closure _.13) 925 | (closure _.14) (closure _.15) (closure _.2) 926 | (closure _.3) (closure _.4) (closure _.5) 927 | (closure _.6) (closure _.7) (closure _.8) 928 | (closure _.9))) 929 | ((assumption 930 | (_.0 _.1 _.2 _.3 _.4 _.5 _.6 _.7 _.8 _.9 _.10 _.11 _.12 931 | _.13 _.14 _.15) 932 | () _.16) 933 | (=/= ((_.0 _.16)) ((_.1 _.16)) ((_.10 _.16)) 934 | ((_.11 _.16)) ((_.12 _.16)) ((_.13 _.16)) 935 | ((_.14 _.16)) ((_.15 _.16)) ((_.16 _.2)) ((_.16 _.3)) 936 | ((_.16 _.4)) ((_.16 _.5)) ((_.16 _.6)) ((_.16 _.7)) 937 | ((_.16 _.8)) ((_.16 _.9))) 938 | (absento (closure _.0) (closure _.1) (closure _.10) 939 | (closure _.11) (closure _.12) (closure _.13) 940 | (closure _.14) (closure _.15) (closure _.16) 941 | (closure _.2) (closure _.3) (closure _.4) 942 | (closure _.5) (closure _.6) (closure _.7) 943 | (closure _.8) (closure _.9))))) 944 | --------------------------------------------------------------------------------