├── .gitmodules ├── LICENSE ├── README.md ├── append ├── interp-with-variadic-lambda.scm └── variadic-lambda-tests.scm ├── explicit-errors ├── error-interp-specific-all.scm └── explicit-error-tests.scm └── unspecified-behavior ├── interp-curried-two-directions-tests.scm └── interp-curried-two-directions.scm /.gitmodules: -------------------------------------------------------------------------------- 1 | [submodule "mk"] 2 | path = mk 3 | url = git@github.com:webyrd/miniKanren-with-symbolic-constraints.git 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 | # cool-relational-interpreter-examples 2 | Fun, interesting, and thought-provoking examples of relational Scheme interpreters at work. 3 | 4 | I'm working with Michael Ballantyne to find/create additional interesting examples. Michael suggested running the Scheme definition of `append` as a relation, which has led to many interesting examples. 5 | 6 | --- 7 | 8 | The miniKanren implementation is a git submodule. Once you clone this repo, you can get the miniKanren implementation by running: 9 | 10 | ``` 11 | git submodule init 12 | git submodule update 13 | ``` 14 | 15 | All examples run under Vicare Scheme and Petite Chez Scheme. OS X users may be interested in Michael Ballantyne's Homebrew formula for Vicare: 16 | 17 | https://github.com/michaelballantyne/homebrew-vicare 18 | 19 | --- 20 | 21 | The examples in `append/variadic-lambda-tests.scm` concentrate on uses of `append` (list concatenation) in a relational Scheme interpreter supporting variadic functions, `apply`, `letrec`, `list`, `car`, `cdr`, `cons`, and other built-ins. The examples show how `append` can be implemented using the normal Scheme definition, but treated as a relation, since the interpreter itself is a relation. The resulting relational behavior of `append` is strictly more general than that of the `appendo` goal often shown in miniKanren tutorials. 22 | 23 | --- 24 | 25 | The examples in `unspecified-behavior/interp-curried-two-directions-tests.scm` show how we can infer Scheme expressions whose values differ under left-to-right and right-to-left evaluation orders. The inferred expressions return different values under Vicare Scheme, Petite Chez Scheme, and Racket. 26 | 27 | --- 28 | 29 | The examples in `explicit-errors/explicit-error-tests.scm` show how we can generate Scheme expressions that, when evaluated, signal specific errors. The interpreter can handle two specific types of errors: referencing unbound variables, and taking the `car`/`cdr` of a non-pair value. It should be straight-forward to add other classes of explicit errors. The interpreter uses all possible evaluation orders. 30 | 31 | --- -------------------------------------------------------------------------------- /append/interp-with-variadic-lambda.scm: -------------------------------------------------------------------------------- 1 | (load "../mk/mk.scm") 2 | 3 | ;; supports variadic lambda: (lambda x x) 4 | 5 | 6 | ;; letrec is based on Dan Friedman's code, using the "half-closure" 7 | ;; approach from Reynold's definitional interpreters 8 | 9 | 10 | (define lookupo 11 | (lambda (x env t) 12 | (conde 13 | ((fresh (y v rest) 14 | (== `(ext-env ,y ,v ,rest) env) 15 | (conde 16 | ((== y x) (== v t)) 17 | ((=/= y x) (lookupo x rest t))))) 18 | 19 | ((fresh (defs rest) 20 | (== `(ext-rec ,defs ,rest) env) 21 | (lookup-ext-reco x defs env rest t))) 22 | 23 | ))) 24 | 25 | (define lookup-ext-reco 26 | (lambda (x defs env rest t) 27 | (fresh (y lam-exp others) 28 | (conde 29 | ((== '() defs) (lookupo x rest t)) 30 | ((== `((,y ,lam-exp) . ,others) defs) 31 | (conde 32 | ((== y x) (== `(closure ,lam-exp ,env) t)) 33 | ((=/= y x) (lookup-ext-reco x others env rest t)))))))) 34 | 35 | (define not-in-envo 36 | (lambda (x env) 37 | (conde 38 | ((== '() env)) 39 | ((fresh (y v rest) 40 | (== `(ext-env ,y ,v ,rest) env) 41 | (=/= y x) 42 | (not-in-envo x rest))) 43 | 44 | ((fresh (defs rest) 45 | (== `(ext-rec ,defs ,rest) env) 46 | (not-in-defso x defs) 47 | (not-in-envo x rest))) 48 | 49 | ))) 50 | 51 | (define not-in-defso 52 | (lambda (x defs) 53 | (conde 54 | ((== '() defs)) 55 | ((fresh (y lam-exp others) 56 | (== `((,y ,lam-exp) . ,others) defs) 57 | (=/= y x) 58 | (not-in-defso x others)))))) 59 | 60 | (define eval-listo 61 | (lambda (exp env val) 62 | (conde 63 | ((== '() exp) 64 | (== '() val)) 65 | ((fresh (a d v-a v-d) 66 | (== `(,a . ,d) exp) 67 | (== `(,v-a . ,v-d) val) 68 | (eval-expo a env v-a) 69 | (eval-listo d env v-d)))))) 70 | 71 | ;; need to make sure lambdas are well formed. 72 | ;; grammar constraints would be useful here!!! 73 | (define list-of-symbolso 74 | (lambda (los) 75 | (conde 76 | ((== '() los)) 77 | ((fresh (a d) 78 | (== `(,a . ,d) los) 79 | (symbolo a) 80 | (list-of-symbolso d)))))) 81 | 82 | 83 | (define listo 84 | (lambda (ls) 85 | (conde 86 | ((== '() ls)) 87 | ((fresh (a d) 88 | (== `(,a . ,d) ls) 89 | (listo d)))))) 90 | 91 | (define evalo 92 | (lambda (exp val) 93 | (eval-expo exp '() val))) 94 | 95 | (define eval-expo 96 | (lambda (exp env val) 97 | (conde 98 | 99 | ((== `(quote ,val) exp) 100 | (absento 'closure val) 101 | (not-in-envo 'quote env)) 102 | 103 | ((symbolo exp) (lookupo exp env val)) 104 | 105 | ;; should possibly combine these lambda clauses, application clauses, apply clauses, and letrec clauses 106 | 107 | ((fresh (x body) 108 | (== `(lambda ,x ,body) exp) 109 | (== `(closure (lambda ,x ,body) ,env) val) 110 | (symbolo x) 111 | (not-in-envo 'lambda env))) 112 | 113 | ((fresh (x* body) 114 | (== `(lambda ,x* ,body) exp) 115 | (== `(closure (lambda ,x* ,body) ,env) val) 116 | (list-of-symbolso x*) 117 | (not-in-envo 'lambda env))) 118 | 119 | ;; apply for variadic procedure 120 | ((fresh (e e* x body env^ a* res) 121 | (== `(apply ,e ,e*) exp) 122 | (not-in-envo 'apply env) 123 | (symbolo x) 124 | (== `(ext-env ,x ,a* ,env^) res) 125 | (eval-expo e env `(closure (lambda ,x ,body) ,env^)) 126 | (eval-expo e* env a*) 127 | (listo a*) 128 | (eval-expo body res val))) 129 | 130 | ;; apply for mult-argument procedure 131 | ((fresh (e e* x x* body env^ a* res) 132 | (== `(apply ,e ,e*) exp) 133 | (not-in-envo 'apply env) 134 | (symbolo x) 135 | (ext-env*o `(,x . ,x*) a* env^ res) 136 | (eval-expo e env `(closure (lambda (,x . ,x*) ,body) ,env^)) 137 | (eval-expo e* env a*) 138 | (listo a*) 139 | (eval-expo body res val))) 140 | 141 | ((fresh (a*) 142 | (== `(list . ,a*) exp) 143 | (not-in-envo 'list env) 144 | (eval-listo a* env val))) 145 | 146 | ((fresh (rator x rands body env^ a* res) 147 | (== `(,rator . ,rands) exp) 148 | (symbolo x) 149 | (== `(ext-env ,x ,a* ,env^) res) 150 | (eval-expo rator env `(closure (lambda ,x ,body) ,env^)) 151 | 152 | (eval-expo body res val) ;; perfect example of two serious 153 | ;; calls in which it isn't clear 154 | ;; which one should come first 155 | (eval-listo rands env a*))) 156 | 157 | ((fresh (rator x* rands body env^ a* res) 158 | (== `(,rator . ,rands) exp) 159 | (eval-expo rator env `(closure (lambda ,x* ,body) ,env^)) 160 | (eval-listo rands env a*) 161 | (ext-env*o x* a* env^ res) 162 | (eval-expo body res val))) 163 | 164 | ((fresh (p-name x body letrec-body) 165 | (== `(letrec ((,p-name (lambda ,x ,body))) ;; single-function variadic letrec version 166 | ,letrec-body) 167 | exp) 168 | (symbolo x) 169 | (not-in-envo 'letrec env) 170 | (eval-expo letrec-body 171 | `(ext-rec ((,p-name (lambda ,x ,body))) ,env) 172 | val))) 173 | 174 | ((fresh (p-name x* body letrec-body) 175 | (== `(letrec ((,p-name (lambda ,x* ,body))) ;; single-function multiple-argument letrec version 176 | ,letrec-body) 177 | exp) 178 | (list-of-symbolso 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 | ;;; don't comment this out accidentally!!! 185 | ((prim-expo exp env val)) 186 | 187 | ))) 188 | 189 | (define ext-env*o 190 | (lambda (x* a* env out) 191 | (conde 192 | ((== '() x*) (== '() a*) (== env out)) 193 | ((fresh (x a dx* da* env2) 194 | (== `(,x . ,dx*) x*) 195 | (== `(,a . ,da*) a*) 196 | (== `(ext-env ,x ,a ,env) env2) 197 | (symbolo x) 198 | (ext-env*o dx* da* env2 out)))))) 199 | 200 | (define prim-expo 201 | (lambda (exp env val) 202 | (conde 203 | ((boolean-primo exp env val)) 204 | ((null?-primo exp env val)) 205 | ((symbol?-primo exp env val)) 206 | ((not-primo exp env val)) 207 | ((car-primo exp env val)) 208 | ((cdr-primo exp env val)) 209 | ((cons-primo exp env val)) 210 | ((equal?-primo exp env val)) 211 | ((if-primo exp env val))))) 212 | 213 | (define boolean-primo 214 | (lambda (exp env val) 215 | (conde 216 | ((== #t exp) (== #t val)) 217 | ((== #f exp) (== #f val))))) 218 | 219 | (define equal?-primo 220 | (lambda (exp env val) 221 | (fresh (e1 e2 v1 v2) 222 | (== `(equal? ,e1 ,e2) exp) 223 | (conde 224 | ((== v1 v2) (== #t val)) 225 | ((=/= v1 v2) (== #f val))) 226 | (not-in-envo 'equal? env) 227 | (eval-expo e1 env v1) 228 | (eval-expo e2 env v2)))) 229 | 230 | (define cons-primo 231 | (lambda (exp env val) 232 | (fresh (a d v-a v-d) 233 | (== `(cons ,a ,d) exp) 234 | (== `(,v-a . ,v-d) val) 235 | (not-in-envo 'cons env) 236 | (eval-expo a env v-a) 237 | (eval-expo d env v-d)))) 238 | 239 | (define car-primo 240 | (lambda (exp env val) 241 | (fresh (p a d) 242 | (== `(car ,p) exp) 243 | (== a val) 244 | (=/= 'closure a) 245 | (not-in-envo 'car env) 246 | (eval-expo p env `(,a . ,d))))) 247 | 248 | (define cdr-primo 249 | (lambda (exp env val) 250 | (fresh (p a d) 251 | (== `(cdr ,p) exp) 252 | (== d val) 253 | (=/= 'closure a) 254 | (not-in-envo 'cdr env) 255 | (eval-expo p env `(,a . ,d))))) 256 | 257 | (define not-primo 258 | (lambda (exp env val) 259 | (fresh (e b) 260 | (== `(not ,e) exp) 261 | (conde 262 | ((=/= #f b) (== #f val)) 263 | ((== #f b) (== #t val))) 264 | (not-in-envo 'not env) 265 | (eval-expo e env b)))) 266 | 267 | (define symbol?-primo 268 | (lambda (exp env val) 269 | (fresh (e v) 270 | (== `(symbol? ,e) exp) 271 | (conde 272 | ((symbolo v) (== #t val)) 273 | ((numbero v) (== #f val)) 274 | ((fresh (a d) 275 | (== `(,a . ,d) v) 276 | (== #f val)))) 277 | (not-in-envo 'symbol? env) 278 | (eval-expo e env v)))) 279 | 280 | (define null?-primo 281 | (lambda (exp env val) 282 | (fresh (e v) 283 | (== `(null? ,e) exp) 284 | (conde 285 | ((== '() v) (== #t val)) 286 | ((=/= '() v) (== #f val))) 287 | (not-in-envo 'null? env) 288 | (eval-expo e env v)))) 289 | 290 | (define if-primo 291 | (lambda (exp env val) 292 | (fresh (e1 e2 e3 t) 293 | (== `(if ,e1 ,e2 ,e3) exp) 294 | (not-in-envo 'if env) 295 | (eval-expo e1 env t) 296 | (conde 297 | ((=/= #f t) (eval-expo e2 env val)) 298 | ((== #f t) (eval-expo e3 env val)))))) 299 | -------------------------------------------------------------------------------- /append/variadic-lambda-tests.scm: -------------------------------------------------------------------------------- 1 | ;; The version of the relational interpreter in 2 | ;; 'interp-with-variadic-lambda.scm' supports 'apply', variadic 3 | ;; 'lambda'/application, multi-argument 'lambda'/application, and a 4 | ;; fair number of built-ins, such as 'quote', 'list', and 'cons'. 5 | ;; 6 | ;; Importantly, 'apply' has been moved towards the top of the 'conde' 7 | ;; in 'eval-expo', ensuring that the answers will contain many uses of 8 | ;; 'apply'. In general, to get more answers containing a form or 9 | ;; primitive function, move the form towards the top of the 'conde' in 10 | ;; 'eval-expo' (and vice versa to de-emphasize a form). The ordering 11 | ;; of the 'conde' clauses give us some crude control over how 12 | ;; miniKanren explores the search space of terms. 13 | (load "interp-with-variadic-lambda.scm") 14 | (load "../mk/test-check.scm") 15 | (load "../mk/matche.scm") 16 | 17 | ;; Helper Scheme predicate for testing 18 | (define member? (lambda (x ls) (not (not (member x ls))))) 19 | 20 | ;; Standard Scheme definition of append. I've wrapped the definition 21 | ;; in a 'let' to avoid shadowing Scheme's built-in 'append' 22 | ;; definition. 23 | (let () 24 | 25 | (define append 26 | (lambda (l s) 27 | (cond 28 | ((null? l) s) 29 | (else (cons (car l) (append (cdr l) s)))))) 30 | 31 | (test "Scheme append-1" 32 | (append '(a b c) '(d e)) 33 | '(a b c d e)) 34 | 35 | ) 36 | 37 | 38 | ;; Our normal relational 'appendo' definition, written in miniKanren. 39 | ;; 'appendo' doesn't look very Scheme-like, unfortunately. 40 | (let () 41 | 42 | (define appendo 43 | (lambda (l s out) 44 | (conde 45 | ((== '() l) (== s out)) 46 | ((fresh (a d res) 47 | (== `(,a . ,d) l) 48 | (== `(,a . ,res) out) 49 | (appendo d s res)))))) 50 | 51 | (test "appendo-1" 52 | (run* (q) (appendo '(a b c) '(d e) q)) 53 | '((a b c d e))) 54 | 55 | (test "appendo-2" 56 | (run* (q) (appendo '(a b c) q '(a b c d e))) 57 | '((d e))) 58 | 59 | (test "appendo-3" 60 | (run* (x y) (appendo x y '(a b c d e))) 61 | '((() (a b c d e)) 62 | ((a) (b c d e)) 63 | ((a b) (c d e)) 64 | ((a b c) (d e)) 65 | ((a b c d) (e)) 66 | ((a b c d e) ()))) 67 | 68 | (test "appendo-4" 69 | (run 5 (x y z) (appendo x y z)) 70 | '((() _.0 _.0) 71 | ((_.0) _.1 (_.0 . _.1)) 72 | ((_.0 _.1) _.2 (_.0 _.1 . _.2)) 73 | ((_.0 _.1 _.2) _.3 (_.0 _.1 _.2 . _.3)) 74 | ((_.0 _.1 _.2 _.3) _.4 (_.0 _.1 _.2 _.3 . _.4)))) 75 | 76 | ) 77 | 78 | ;; Even the pattern-matching version of 'appendo' doesn't look that 79 | ;; much like the Scheme code. 80 | (let () 81 | 82 | (define appendo 83 | (lambda (l s out) 84 | (matche (l s out) 85 | ((() ,s ,s)) 86 | (((,a . ,d) ,s (,a . ,res)) (appendo d s res))))) 87 | 88 | (test "appendo-1" 89 | (run* (q) (appendo '(a b c) '(d e) q)) 90 | '((a b c d e))) 91 | 92 | (test "appendo-2" 93 | (run* (q) (appendo '(a b c) q '(a b c d e))) 94 | '((d e))) 95 | 96 | (test "appendo-3" 97 | (run* (x y) (appendo x y '(a b c d e))) 98 | '((() (a b c d e)) 99 | ((a) (b c d e)) 100 | ((a b) (c d e)) 101 | ((a b c) (d e)) 102 | ((a b c d) (e)) 103 | ((a b c d e) ()))) 104 | 105 | (test "appendo-4" 106 | (run 5 (x y z) (appendo x y z)) 107 | '((() _.0 _.0) 108 | ((_.0) _.1 (_.0 . _.1)) 109 | ((_.0 _.1) _.2 (_.0 _.1 . _.2)) 110 | ((_.0 _.1 _.2) _.3 (_.0 _.1 _.2 . _.3)) 111 | ((_.0 _.1 _.2 _.3) _.4 (_.0 _.1 _.2 _.3 . _.4)))) 112 | 113 | ) 114 | 115 | 116 | 117 | ;; With the relational Scheme interpreter written in miniKanren, we 118 | ;; can write the *Scheme* definition of 'append', and treat that 119 | ;; *function* as a *relation*. This is because the interpreter itself 120 | ;; is a relation. 121 | ;; 122 | ;; Running append "forwards": 123 | (test "Scheme-append-under-relational-interpreter-1" 124 | (run* (q) 125 | (evalo 126 | '(letrec ((append (lambda (l s) 127 | (if (null? l) 128 | s 129 | (cons (car l) (append (cdr l) s)))))) 130 | (append '(a b c) '(d e))) 131 | q)) 132 | '((a b c d e))) 133 | 134 | ;; Running append "backwards:" 135 | (test "Scheme-append-under-relational-interpreter-2" 136 | (run 6 (x y) 137 | (evalo 138 | `(letrec ((append (lambda (l s) 139 | (if (null? l) 140 | s 141 | (cons (car l) (append (cdr l) s)))))) 142 | (append ,x ,y)) 143 | '(a b c d e))) 144 | '(('() '(a b c d e)) 145 | ('(a) '(b c d e)) 146 | ('(a b) '(c d e)) 147 | ('(a b c) '(d e)) 148 | ('(a b c d) '(e)) 149 | ('(a b c d e) '()))) 150 | 151 | ;; Replacing 'run 6' with 'run*' in 152 | ;; Scheme-append-under-relational-interpreter-2 results in divergence 153 | ;; (looping forever). This seems bad. Aren't there only 6 answers? 154 | 155 | ;; Let's try to generate a seventh answer: 156 | (test "Scheme-append-under-relational-interpreter-3" 157 | (run 7 (x y) 158 | (evalo 159 | `(letrec ((append (lambda (l s) 160 | (if (null? l) 161 | s 162 | (cons (car l) (append (cdr l) s)))))) 163 | (append ,x ,y)) 164 | '(a b c d e))) 165 | '(('() '(a b c d e)) 166 | ('(a) '(b c d e)) 167 | ('(a b) '(c d e)) 168 | ('(a b c) '(d e)) 169 | ('(a b c d) '(e)) 170 | ('(a b c d e) '()) 171 | ('(a b c d e) (list)))) 172 | 173 | ;; Whoa! The last answer has a call to 'list' with no arguments, 174 | ;; producing the empty list! Because we are running 'append' in the 175 | ;; context of the relational Scheme interpreter, the logic variables 176 | ;; 'x' and 'y' in the body of the 'letrec' represent *arbitrary Scheme 177 | ;; expressions* that evaluate to lists of symbols. 178 | 179 | ;; Let's look at a few more answers: 180 | (test "Scheme-append-under-relational-interpreter-4" 181 | (run 20 (x y) 182 | (evalo 183 | `(letrec ((append (lambda (l s) 184 | (if (null? l) 185 | s 186 | (cons (car l) (append (cdr l) s)))))) 187 | (append ,x ,y)) 188 | '(a b c d e))) 189 | '(('() '(a b c d e)) 190 | ('(a) '(b c d e)) 191 | ('(a b) '(c d e)) 192 | ('(a b c) '(d e)) 193 | ('(a b c d) '(e)) 194 | ('(a b c d e) '()) 195 | ('(a b c d e) (list)) 196 | (('() (apply (lambda _.0 '(a b c d e)) '())) 197 | (=/= ((_.0 quote))) 198 | (sym _.0)) 199 | (('(a b c d e) (apply (lambda _.0 _.0) '())) 200 | (sym _.0)) 201 | (('(a) (apply (lambda _.0 '(b c d e)) '())) 202 | (=/= ((_.0 quote))) 203 | (sym _.0)) 204 | (('(a b) (apply (lambda _.0 '(c d e)) '())) 205 | (=/= ((_.0 quote))) 206 | (sym _.0)) 207 | (('(a b c) (apply (lambda _.0 '(d e)) '())) 208 | (=/= ((_.0 quote))) 209 | (sym _.0)) 210 | (('(a b c d) (apply (lambda _.0 '(e)) '())) 211 | (=/= ((_.0 quote))) 212 | (sym _.0)) 213 | (('(a b c d e) (apply (lambda _.0 '()) '())) 214 | (=/= ((_.0 quote))) 215 | (sym _.0)) 216 | ('(a b c d) (list 'e)) 217 | (('(a b c d) (apply (lambda _.0 _.0) '(e))) 218 | (sym _.0)) 219 | (('() (apply (lambda _.0 '(a b c d e)) '(_.1))) 220 | (=/= ((_.0 quote))) 221 | (sym _.0) 222 | (absento (closure _.1))) 223 | (('(a) (apply (lambda _.0 '(b c d e)) '(_.1))) 224 | (=/= ((_.0 quote))) 225 | (sym _.0) 226 | (absento (closure _.1))) 227 | (('(a b) (apply (lambda _.0 '(c d e)) '(_.1))) 228 | (=/= ((_.0 quote))) 229 | (sym _.0) 230 | (absento (closure _.1))) 231 | (('(a b c) (apply (lambda _.0 '(d e)) '(_.1))) 232 | (=/= ((_.0 quote))) 233 | (sym _.0) 234 | (absento (closure _.1))))) 235 | 236 | ;; Sure enough, later answers call 'list', and even use variadic 237 | ;; 'lambda' and procedure application. So our Scheme 'append', 238 | ;; running in the relational interpreter, is more general than 239 | ;; 'appendo'! 240 | 241 | ;; We can recapture the behavior of 'appendo', in which we restrict 242 | ;; the arguments to lists of values (rather than expressions that 243 | ;; *evaluate* to lists of values) by a careful use of 'quote' inside 244 | ;; the body of the 'letrec': 245 | (test "Scheme-append-under-relational-interpreter-5" 246 | (run* (x y) 247 | (evalo 248 | `(letrec ((append (lambda (l s) 249 | (if (null? l) 250 | s 251 | (cons (car l) (append (cdr l) s)))))) 252 | (append (quote ,x) (quote ,y))) 253 | '(a b c d e))) 254 | '((() (a b c d e)) 255 | ((a) (b c d e)) 256 | ((a b) (c d e)) 257 | ((a b c) (d e)) 258 | ((a b c d) (e)) 259 | ((a b c d e) ()))) 260 | 261 | 262 | ;; In addition to inferring the two list arguments in an 'append' 263 | ;; call, we can infer the actual use of 'append' in the call! 264 | 265 | ;; Our first attempt to infer the use of 'append' is unsuccessful. 266 | ;; miniKanren "cheats" by generating a variadic lambda expression 267 | ;; whose body returns the "output" list. 268 | (test "infer-append-use-1" 269 | (run 1 (q) 270 | (evalo 271 | `(letrec ((append (lambda (l s) 272 | (if (null? l) 273 | s 274 | (cons (car l) (append (cdr l) s)))))) 275 | (,q '(a b c) '(d e))) 276 | '(a b c d e))) 277 | '(((lambda _.0 '(a b c d e)) (=/= ((_.0 quote))) (sym _.0)))) 278 | 279 | ;; We can use the 'absento' constraint to keep miniKanren from 280 | ;; cheating. The constraint '(absento 'a q)' ensures that the symbol 281 | ;; 'a'---which occurs in both the input to the call and the output--- 282 | ;; does not occur in the expression we are trying to infer. 283 | ;; 284 | ;; This results in the expected answer, 'append', and a second 285 | ;; expression that also evaluates to the append procedure. 286 | (test "infer-append-use-2" 287 | (run 2 (q) 288 | (evalo 289 | `(letrec ((append (lambda (l s) 290 | (if (null? l) 291 | s 292 | (cons (car l) (append (cdr l) s)))))) 293 | (,q '(a b c) '(d e))) 294 | '(a b c d e)) 295 | (absento 'a q)) 296 | '(append 297 | ((apply (lambda _.0 append) '()) 298 | (=/= ((_.0 a)) ((_.0 append))) 299 | (sym _.0)))) 300 | 301 | 302 | ;; We can also infer missing sub-expressions from the definition of 303 | ;; 'append'. Here we infer the missing '(car l)' call from the 'else' 304 | ;; branch of the 'if' expression. The second answer is an expression 305 | ;; whose behavior is equivalent to that of '(car l)'. 306 | ;; 307 | ;; Several subexpressions are quick to infer. Other subexpressions 308 | ;; take a very long time to infer. The interpreter cannot (yet) be 309 | ;; practically used for example-based program synthesis of programs 310 | ;; like 'append', but there may be improvements to the miniKanren 311 | ;; implementation, the relational interpreter, and our inference 312 | ;; techniques which would make example-based synthesis feasible in 313 | ;; practice. We are currently exploring this research area. 314 | (test "infer-car-1" 315 | (run 2 (q) 316 | (absento 'a q) 317 | (evalo 318 | `(letrec ((append (lambda (l s) 319 | (if (null? l) 320 | s 321 | (cons ,q (append (cdr l) s)))))) 322 | (append '(a b c) '(d e))) 323 | '(a b c d e))) 324 | '((car l) 325 | ((apply (lambda _.0 (car l)) s) 326 | (=/= ((_.0 a)) ((_.0 car)) ((_.0 l))) (sym _.0)))) 327 | 328 | 329 | ;; One fun thing we can do with the relational interpreter is generate 330 | ;; Scheme programs that evaluate to a given value. For example, here 331 | ;; are ten Scheme expressions that evaluate to the list '(I love you)'. 332 | (test "I-love-you-1" 333 | (run 10 (q) 334 | (evalo 335 | q 336 | '(I love you))) 337 | '('(I love you) 338 | ((apply (lambda _.0 '(I love you)) '()) 339 | (=/= ((_.0 quote))) 340 | (sym _.0)) 341 | ((apply (lambda _.0 '(I love you)) '(_.1)) 342 | (=/= ((_.0 quote))) 343 | (sym _.0) 344 | (absento (closure _.1))) 345 | ((apply (lambda _.0 '(I love you)) '(_.1 _.2)) 346 | (=/= ((_.0 quote))) 347 | (sym _.0) 348 | (absento (closure _.1) (closure _.2))) 349 | ((apply (lambda (_.0) '(I love you)) '(_.1)) 350 | (=/= ((_.0 quote))) 351 | (sym _.0) 352 | (absento (closure _.1))) 353 | ((apply (lambda (_.0) _.0) '((I love you))) 354 | (sym _.0)) 355 | (list 'I 'love 'you) 356 | (((lambda _.0 '(I love you))) 357 | (=/= ((_.0 quote))) 358 | (sym _.0)) 359 | ((apply (lambda _.0 '(I love you)) '(_.1 _.2 _.3)) 360 | (=/= ((_.0 quote))) 361 | (sym _.0) 362 | (absento (closure _.1) (closure _.2) (closure _.3))) 363 | (((lambda _.0 '(I love you)) '_.1) 364 | (=/= ((_.0 quote))) 365 | (sym _.0) 366 | (absento (closure _.1))))) 367 | 368 | 369 | ;; Here is where the real fun begins! 370 | ;; 371 | ;; We can run a similar query to the one above, generating one 372 | ;; thousand Scheme expressions that evaluate to the list '(I love you)'. 373 | ;; However, we introduce a new twist. We place the query variable 374 | ;; in the body of the 'letrec' in which we have defined 'append'. 375 | ;; Therefore, miniKanren is free to infer expressions that use 'append', 376 | ;; even though 'append' is not one of the primitives built into 377 | ;; the relational Scheme interpreter! 378 | (define I-love-you-append (run 1000 (q) 379 | (evalo 380 | `(letrec ((append (lambda (l s) 381 | (if (null? l) 382 | s 383 | (cons (car l) (append (cdr l) s)))))) 384 | ,q) 385 | '(I love you)))) 386 | 387 | ;; Here are a few interesting answers, all of which evaluate to '(I love you)'. 388 | 389 | (test "I-love-you-append-1" 390 | (member? '(apply append '((I love) (you))) 391 | I-love-you-append) 392 | #t) 393 | 394 | (test "I-love-you-append-2" 395 | (member? '((apply (lambda _.0 (apply append '((I love) (you)))) '()) 396 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 quote))) 397 | (sym _.0)) 398 | I-love-you-append) 399 | #t) 400 | 401 | (test "I-love-you-append-3" 402 | (member? '(((lambda _.0 '(I love you)) append append append append) 403 | (=/= ((_.0 quote))) (sym _.0)) 404 | I-love-you-append) 405 | #t) 406 | 407 | (test "I-love-you-append-4" 408 | (member? '((apply (lambda _.0 (apply append '((I) (love you)))) '()) 409 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 quote))) 410 | (sym _.0)) 411 | I-love-you-append) 412 | #t) 413 | 414 | (test "I-love-you-append-5" 415 | (member? '((apply append (apply (lambda _.0 '((I love) (you))) '())) 416 | (=/= ((_.0 quote))) (sym _.0)) 417 | I-love-you-append) 418 | #t) 419 | 420 | (test "I-love-you-append-6" 421 | (member? '((apply (lambda _.0 (car _.0)) '((I love you))) 422 | (=/= ((_.0 car))) (sym _.0)) 423 | I-love-you-append) 424 | #t) 425 | 426 | ;; This example illustrates how 'append' can be used as a "dummy" value, 427 | ;; passed into the variadic function but never used. 428 | (test "I-love-you-append-7" 429 | (member? '(((lambda _.0 '(I love you)) append append append append) 430 | (=/= ((_.0 quote))) (sym _.0)) 431 | I-love-you-append) 432 | #t) 433 | 434 | 435 | ;; Our relational interpreter can also generate quines, which are 436 | ;; Scheme expressions that evaluate to themselves. 437 | (test "simple quines" 438 | (run 5 (q) (evalo q q)) 439 | '(#t 440 | #f 441 | ((apply 442 | (lambda _.0 443 | (list 'apply (apply (lambda (_.1) _.1) _.0) 444 | (list 'quote _.0))) 445 | '((lambda _.0 446 | (list 'apply (apply (lambda (_.1) _.1) _.0) 447 | (list 'quote _.0))))) 448 | (=/= ((_.0 apply)) ((_.0 closure)) ((_.0 lambda)) 449 | ((_.0 list)) ((_.0 quote)) ((_.1 closure))) 450 | (sym _.0 _.1)) 451 | ((apply 452 | (lambda _.0 453 | (list (apply (lambda _.1 'apply) '()) 454 | (apply (lambda (_.2) _.2) _.0) (list 'quote _.0))) 455 | '((lambda _.0 456 | (list (apply (lambda _.1 'apply) '()) 457 | (apply (lambda (_.2) _.2) _.0) (list 'quote _.0))))) 458 | (=/= ((_.0 apply)) ((_.0 closure)) ((_.0 lambda)) 459 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) 460 | ((_.1 quote)) ((_.2 closure))) 461 | (sym _.0 _.1 _.2)) 462 | ((apply (lambda _.0 (list 'apply _.0 (list 'quote _.0))) 463 | '(lambda _.0 (list 'apply _.0 (list 'quote _.0)))) 464 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 465 | (sym _.0)))) 466 | 467 | 468 | ;; And, of course, we can generate quines in the context of the 469 | ;; definition of 'append'. 470 | (define quines-in-context-of-append 471 | (run 60 (q) 472 | (evalo 473 | `(letrec ((append (lambda (l s) 474 | (if (null? l) 475 | s 476 | (cons (car l) (append (cdr l) s)))))) 477 | ,q) 478 | q))) 479 | 480 | 481 | ;; Here are a few of the generated quines. All but the first and last 482 | ;; example use 'append'. 483 | 484 | (test "quines-in-context-of-append-1" 485 | (member? '((apply (lambda _.0 (list 'apply _.0 (list 'quote _.0))) 486 | '(lambda _.0 (list 'apply _.0 (list 'quote _.0)))) 487 | (=/= ((_.0 closure)) ((_.0 list)) ((_.0 quote))) 488 | (sym _.0)) 489 | quines-in-context-of-append) 490 | #t) 491 | 492 | (test "quines-in-context-of-append-2" 493 | (member? '((apply 494 | (lambda _.0 495 | (list 'apply (apply append _.0) (list 'quote _.0))) 496 | '(() 497 | (lambda _.0 498 | (list 'apply (apply append _.0) (list 'quote _.0))))) 499 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 closure)) 500 | ((_.0 list)) ((_.0 quote))) 501 | (sym _.0)) 502 | quines-in-context-of-append) 503 | #t) 504 | 505 | (test "quines-in-context-of-append-3" 506 | (member? '((apply 507 | (lambda _.0 508 | (list 'apply (apply append _.0) 509 | ((lambda _.1 _.1) 'quote _.0))) 510 | '(() 511 | (lambda _.0 512 | (list 'apply (apply append _.0) 513 | ((lambda _.1 _.1) 'quote _.0))))) 514 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 closure)) 515 | ((_.0 lambda)) ((_.0 list)) ((_.0 quote)) 516 | ((_.1 closure))) 517 | (sym _.0 _.1)) 518 | quines-in-context-of-append) 519 | #t) 520 | 521 | (test "quines-in-context-of-append-4" 522 | (member? '((apply 523 | (lambda _.0 524 | (list 'apply (apply append _.0) 525 | (apply (lambda _.1 (list 'quote _.1)) _.0))) 526 | '(() 527 | (lambda _.0 528 | (list 'apply (apply append _.0) 529 | (apply (lambda _.1 (list 'quote _.1)) _.0))))) 530 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 closure)) 531 | ((_.0 lambda)) ((_.0 list)) ((_.0 quote)) 532 | ((_.1 closure)) ((_.1 list)) ((_.1 quote))) 533 | (sym _.0 _.1)) 534 | quines-in-context-of-append) 535 | #t) 536 | 537 | (test "quines-in-context-of-append-5" 538 | (member? '((apply 539 | (lambda _.0 540 | (list (apply (lambda _.1 'apply) _.0) 541 | (apply append _.0) (list 'quote _.0))) 542 | '(() 543 | (lambda _.0 544 | (list (apply (lambda _.1 'apply) _.0) 545 | (apply append _.0) (list 'quote _.0))))) 546 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 closure)) 547 | ((_.0 lambda)) ((_.0 list)) ((_.0 quote)) 548 | ((_.1 closure)) ((_.1 quote))) 549 | (sym _.0 _.1)) 550 | quines-in-context-of-append) 551 | #t) 552 | 553 | (test "quines-in-context-of-append-6" 554 | (member? '((apply 555 | (lambda _.0 556 | (list 'apply (apply append _.0) 557 | (apply (lambda _.1 (list 'quote _.0)) _.0))) 558 | '(() 559 | (lambda _.0 560 | (list 'apply (apply append _.0) 561 | (apply (lambda _.1 (list 'quote _.0)) _.0))))) 562 | (=/= ((_.0 _.1)) ((_.0 append)) ((_.0 apply)) 563 | ((_.0 closure)) ((_.0 lambda)) ((_.0 list)) 564 | ((_.0 quote)) ((_.1 closure)) ((_.1 list)) 565 | ((_.1 quote))) 566 | (sym _.0 _.1)) 567 | quines-in-context-of-append) 568 | #t) 569 | 570 | (test "quines-in-context-of-append-7" 571 | (member? '((apply 572 | (lambda _.0 573 | (list 'apply (apply append _.0) 574 | (list 'quote (apply (lambda _.1 _.1) _.0)))) 575 | '(() 576 | (lambda _.0 577 | (list 'apply (apply append _.0) 578 | (list 'quote (apply (lambda _.1 _.1) _.0)))))) 579 | (=/= ((_.0 append)) ((_.0 apply)) ((_.0 closure)) 580 | ((_.0 lambda)) ((_.0 list)) ((_.0 quote)) 581 | ((_.1 closure))) 582 | (sym _.0 _.1)) 583 | quines-in-context-of-append) 584 | #t) 585 | 586 | (test "quines-in-context-of-append-8" 587 | (member? '((apply 588 | (lambda _.0 589 | (list 'apply (apply (lambda (_.1) _.1) _.0) 590 | (apply (lambda _.2 ((lambda _.3 _.3) 'quote _.2)) 591 | _.0))) 592 | '((lambda _.0 593 | (list 'apply (apply (lambda (_.1) _.1) _.0) 594 | (apply (lambda _.2 ((lambda _.3 _.3) 'quote _.2)) 595 | _.0))))) 596 | (=/= ((_.0 apply)) ((_.0 closure)) ((_.0 lambda)) 597 | ((_.0 list)) ((_.0 quote)) ((_.1 closure)) 598 | ((_.2 closure)) ((_.2 lambda)) ((_.2 quote)) 599 | ((_.3 closure))) 600 | (sym _.0 _.1 _.2 _.3)) 601 | quines-in-context-of-append) 602 | #t) 603 | 604 | 605 | -------------------------------------------------------------------------------- /explicit-errors/error-interp-specific-all.scm: -------------------------------------------------------------------------------- 1 | (load "../mk/mk.scm") 2 | 3 | ;; error-handling Scheme interpreter 4 | ;; 5 | ;; two types of error (referencing unbound variable, or taking car/cdr of a non-pair (really a closure)) 6 | ;; 7 | ;; errors are now represented as tagged lists, with specific messages 8 | ;; 9 | ;; this version of the interpreter uses *every* legal Scheme 10 | ;; evaluation order for programs that generate errors (rather than 11 | ;; left-to-right order, for example) 12 | 13 | (define eval-expo 14 | (lambda (exp env val) 15 | (fresh () 16 | (absento 'ERROR exp) 17 | (absento 'ERROR env) 18 | (absento 'closure exp) 19 | (conde 20 | ((== `(quote ,val) exp) 21 | (not-in-envo 'quote env)) 22 | ((fresh (x body) 23 | (== `(lambda (,x) ,body) exp) 24 | (== `(closure ,x ,body ,env) val) 25 | (symbolo x))) 26 | ((symbolo exp) (lookupo exp env val)) 27 | ((fresh (e1 e2 v1 v2) 28 | (== `(cons ,e1 ,e2) exp) 29 | (conde 30 | ((absento 'ERROR val) 31 | (== `(,v1 . ,v2) val) 32 | (eval-expo e1 env v1) 33 | (eval-expo e2 env v2)) 34 | ((fresh (msg) 35 | (== `(ERROR . ,msg) val) 36 | (conde 37 | ((eval-expo e1 env `(ERROR . ,msg))) 38 | ((eval-expo e2 env `(ERROR . ,msg))))))))) 39 | ((fresh (rator rand x body env^ a) 40 | (== `(,rator ,rand) exp) 41 | (conde 42 | ((absento 'ERROR val) 43 | (eval-expo rator env `(closure ,x ,body ,env^)) 44 | (eval-expo rand env a) 45 | (eval-expo body `((,x . ,a) . ,env^) val)) 46 | ((fresh (msg) 47 | (== `(ERROR . ,msg) val) 48 | (conde 49 | ( 50 | ;; must be careful here! 51 | ;; 52 | ;; we can't depend on the evaluation of rator to ensure 53 | ;; application isn't overlapping with quote, for example 54 | (=/= 'quote rator) 55 | (=/= 'car rator) 56 | (=/= 'cdr rator) 57 | (eval-expo rator env `(ERROR . ,msg))) 58 | ((=/= 'quote rator) 59 | (=/= 'car rator) 60 | (=/= 'cdr rator) 61 | (eval-expo rand env `(ERROR . ,msg))) 62 | ((eval-expo rator env `(closure ,x ,body ,env^)) 63 | (eval-expo rand env a) 64 | (eval-expo body `((,x . ,a) . ,env^) `(ERROR . ,msg))))))))) 65 | ((fresh (e) 66 | (== `(car ,e) exp) 67 | (not-in-envo 'car env) 68 | (conde 69 | ((fresh (v1 v2) 70 | (absento 'ERROR `(,v1 . ,v2)) 71 | (=/= 'closure v1) 72 | (== v1 val) 73 | (eval-expo e env `(,v1 . ,v2)))) 74 | ((fresh (msg) 75 | (== `(ERROR . ,msg) val) 76 | (conde 77 | ((eval-expo e env `(ERROR . ,msg))) 78 | ((fresh (v) 79 | (== `(ERROR ATTEMPT-TO-TAKE-CAR-OF-NON-PAIR ,v) val) 80 | (absento 'ERROR v) 81 | (not-pairo v) 82 | (eval-expo e env v))))))))) 83 | ((fresh (e) 84 | (== `(cdr ,e) exp) 85 | (not-in-envo 'cdr env) 86 | (conde 87 | ((fresh (v1 v2) 88 | (absento 'ERROR `(,v1 . ,v2)) 89 | (=/= 'closure v1) 90 | (== v2 val) 91 | (eval-expo e env `(,v1 . ,v2)))) 92 | ((fresh (msg) 93 | (== `(ERROR . ,msg) val) 94 | (conde 95 | ((eval-expo e env `(ERROR . ,msg))) 96 | ((fresh (v) 97 | (== `(ERROR ATTEMPT-TO-TAKE-CDR-OF-NON-PAIR ,v) val) 98 | (absento 'ERROR v) 99 | (not-pairo v) 100 | (eval-expo e env v))))))))))))) 101 | 102 | 103 | (define (not-in-envo x env) 104 | (conde 105 | ((== '() env)) 106 | ((fresh (a d) 107 | (== `(,a . ,d) env) 108 | (=/= x a) 109 | (not-in-envo x d))))) 110 | 111 | (define (not-pairo v) 112 | (fresh (x body env) 113 | (== `(closure ,x ,body ,env) v))) 114 | 115 | 116 | (define lookupo 117 | (lambda (x env t) 118 | (conde 119 | ((== env '()) 120 | (== `(ERROR UNBOUND-VARIABLE ,x) t)) 121 | ((fresh (rest y v) 122 | (== `((,y . ,v) . ,rest) env) 123 | (conde 124 | ((== y x) (== v t)) 125 | ((=/= y x) (lookupo x rest t)))))))) 126 | -------------------------------------------------------------------------------- /explicit-errors/explicit-error-tests.scm: -------------------------------------------------------------------------------- 1 | ;; The relational Scheme interpreter in 2 | ;; 'error-interp-specific-all.scm' produces explicit error messages 3 | ;; for two classes of errors, rather than failing when those specific 4 | ;; errors are encountered during execution. The two errors are 5 | ;; unbound variable reference, and attempt to take the car/cdr of a 6 | ;; non-pair. Other errors, such as attempts to apply non-procedures, 7 | ;; could also be explicitly modelled---currently, such errors result 8 | ;; in failure. 9 | ;; 10 | ;; Error are represented as tagged lists, with specific error 11 | ;; messages. This makes it possible to generate programs that signal 12 | ;; specific errors when evaluated in Scheme. 13 | ;; 14 | ;; This interpreter also tries *every* legal Scheme evaluation order 15 | ;; when evaluating arguments to a procedure call/primitive call 16 | ;; (rather than left-to-right evaluation order, for example). 17 | (load "../mk/test-check.scm") 18 | (load "error-interp-specific-all.scm") 19 | 20 | 21 | ;; We'll begin with four queries showing the standard behavior 22 | ;; of a relational Scheme interpreter, without generating errors. 23 | 24 | 25 | ;; Simple example of the evaluator running "forward", evaluating an 26 | ;; expression that doesn't signal an error. 27 | (test "1" 28 | (run* (q) (eval-expo '(lambda (x) x) '() q)) 29 | '((closure x x ()))) 30 | 31 | ;; Simple example of running "backwards", generating five expressions 32 | ;; that evaluate to the identity procedure. 33 | (test "2" 34 | (run 5 (q) (eval-expo q '() '(closure x x ()))) 35 | '((lambda (x) x) 36 | (((lambda (_.0) _.0) (lambda (x) x)) 37 | (=/= ((_.0 ERROR)) ((_.0 closure))) 38 | (sym _.0)) 39 | ((car (cons (lambda (x) x) '_.0)) 40 | (absento (ERROR _.0) (closure _.0))) 41 | ((cdr (cons '_.0 (lambda (x) x))) 42 | (absento (ERROR _.0) (closure _.0))) 43 | ((car (cons (lambda (x) x) (lambda (_.0) _.1))) 44 | (=/= ((_.0 ERROR)) ((_.0 closure))) 45 | (sym _.0) 46 | (absento (ERROR _.1) (closure _.1))))) 47 | 48 | ;; Obligatory quine generation. We generate a program 'q' that 49 | ;; evaluates to itself. 50 | (test "3" 51 | (run 1 (q) 52 | (eval-expo q '() q)) 53 | '((((lambda (_.0) 54 | (cons _.0 (cons (cons 'quote (cons _.0 '())) '()))) 55 | '(lambda (_.0) 56 | (cons _.0 (cons (cons 'quote (cons _.0 '())) '())))) 57 | (=/= ((_.0 ERROR)) ((_.0 closure))) (sym _.0)))) 58 | 59 | ;; Similarly, we can generate Scheme expressions that evaluate to the 60 | ;; list (I love you). 61 | (test "4" 62 | (run 10 (q) 63 | (eval-expo q '() '(I love you))) 64 | '('(I love you) 65 | (cons 'I '(love you)) 66 | ((car '((I love you) . _.0)) 67 | (absento (ERROR _.0) (closure _.0))) 68 | ((cdr '(_.0 I love you)) 69 | (absento (ERROR _.0) (closure _.0))) 70 | (((lambda (_.0) '(I love you)) '_.1) 71 | (=/= ((_.0 ERROR)) ((_.0 closure))) 72 | (sym _.0) 73 | (absento (ERROR _.1) (closure _.1))) 74 | (cons 'I (cons 'love '(you))) 75 | (((lambda (_.0) _.0) '(I love you)) 76 | (=/= ((_.0 ERROR)) ((_.0 closure))) 77 | (sym _.0)) 78 | (((lambda (_.0) '(I love you)) (lambda (_.1) _.2)) 79 | (=/= ((_.0 ERROR)) ((_.0 closure)) ((_.1 ERROR)) ((_.1 closure))) 80 | (sym _.0 _.1) 81 | (absento (ERROR _.2) (closure _.2))) 82 | ((cons (car '(I . _.0)) '(love you)) 83 | (absento (ERROR _.0) (closure _.0))) 84 | ((cons (cdr '(_.0 . I)) '(love you)) 85 | (absento (ERROR _.0) (closure _.0))))) 86 | 87 | 88 | ;; Now let's evaluate (and generate!) Scheme expressions that signal 89 | ;; an error. 90 | 91 | 92 | ;; Evaluating (car (lambda (x) x)) produces an error, represented as a 93 | ;; tagged list. Separating the error description into a generic tag 94 | ;; (ERROR), a specific error-type tag 95 | ;; (ATTEMPT-TO-TAKE-CAR-OF-NON-PAIR), and an "irritant" value 96 | ;; ((closure x x ())) gives us useful information when running 97 | ;; forward, and gives us lots of control over the query when running 98 | ;; backwards. 99 | (test "5" 100 | (run* (q) (eval-expo '(car (lambda (x) x)) '() q)) 101 | '((ERROR ATTEMPT-TO-TAKE-CAR-OF-NON-PAIR (closure x x ())))) 102 | 103 | ;; Taking the cdr rather than the car of a procedure gives us a 104 | ;; different error-type tag. 105 | (test "6" 106 | (run* (q) (eval-expo '(cdr (lambda (x) x)) '() q)) 107 | '((ERROR ATTEMPT-TO-TAKE-CDR-OF-NON-PAIR (closure x x ())))) 108 | 109 | ;; Of course, evaluation works inside-out... 110 | (test "7" 111 | (run* (q) (eval-expo '(car (cdr (lambda (x) x))) '() q)) 112 | '((ERROR ATTEMPT-TO-TAKE-CDR-OF-NON-PAIR (closure x x ())))) 113 | 114 | ;; Another type of error: unbound variable reference, with irritant 115 | ;; 'x'. 116 | (test "8" 117 | (run* (q) 118 | (eval-expo `((lambda (y) x) (lambda (z) z)) '() q)) 119 | '((ERROR UNBOUND-VARIABLE x))) 120 | 121 | ;; Time to run backwards! Let's generate ten Scheme expressions that 122 | ;; evaluate to one of the error types we explicitly model. Due to the 123 | ;; order of the 'conde' clauses in 'eval-expo', all ten of these 124 | ;; expressions generate UNBOUND-VARIABLE errors. 125 | (test "9" 126 | (run 10 (q msg) 127 | (eval-expo q '() `(ERROR . ,msg))) 128 | '(((_.0 (UNBOUND-VARIABLE _.0)) 129 | (=/= ((_.0 ERROR)) ((_.0 closure))) (sym _.0)) 130 | (((cons _.0 _.1) (UNBOUND-VARIABLE _.0)) 131 | (=/= ((_.0 ERROR)) ((_.0 closure))) (sym _.0) 132 | (absento (ERROR _.1) (closure _.1))) 133 | (((cons _.0 _.1) (UNBOUND-VARIABLE _.1)) 134 | (=/= ((_.1 ERROR)) ((_.1 closure))) (sym _.1) 135 | (absento (ERROR _.0) (closure _.0))) 136 | (((_.0 _.1) (UNBOUND-VARIABLE _.0)) 137 | (=/= ((_.0 ERROR)) ((_.0 car)) ((_.0 cdr)) 138 | ((_.0 closure)) ((_.0 quote))) 139 | (sym _.0) (absento (ERROR _.1) (closure _.1))) 140 | (((_.0 _.1) (UNBOUND-VARIABLE _.1)) 141 | (=/= ((_.0 car)) ((_.0 cdr)) ((_.0 quote)) ((_.1 ERROR)) 142 | ((_.1 closure))) 143 | (sym _.1) (absento (ERROR _.0) (closure _.0))) 144 | (((car _.0) (UNBOUND-VARIABLE _.0)) 145 | (=/= ((_.0 ERROR)) ((_.0 closure))) (sym _.0)) 146 | (((cdr _.0) (UNBOUND-VARIABLE _.0)) 147 | (=/= ((_.0 ERROR)) ((_.0 closure))) (sym _.0)) 148 | (((cons (cons _.0 _.1) _.2) (UNBOUND-VARIABLE _.0)) 149 | (=/= ((_.0 ERROR)) ((_.0 closure))) (sym _.0) 150 | (absento (ERROR _.1) (ERROR _.2) (closure _.1) 151 | (closure _.2))) 152 | (((cons _.0 (cons _.1 _.2)) (UNBOUND-VARIABLE _.1)) 153 | (=/= ((_.1 ERROR)) ((_.1 closure))) (sym _.1) 154 | (absento (ERROR _.0) (ERROR _.2) (closure _.0) 155 | (closure _.2))) 156 | (((cons (cons _.0 _.1) _.2) (UNBOUND-VARIABLE _.1)) 157 | (=/= ((_.1 ERROR)) ((_.1 closure))) (sym _.1) 158 | (absento (ERROR _.0) (ERROR _.2) (closure _.0) 159 | (closure _.2))))) 160 | 161 | ;; Running backwards again, this time specifying that the generated 162 | ;; Scheme expressions must signal an ATTEMPT-TO-TAKE-CAR-OF-NON-PAIR 163 | ;; error when evaluated. We leave the irritant unspecified. 164 | (test "10" 165 | (run 5 (q val) 166 | (eval-expo q '() `(ERROR ATTEMPT-TO-TAKE-CAR-OF-NON-PAIR ,val))) 167 | '((((car (lambda (_.0) _.1)) 168 | (closure _.0 _.1 ())) 169 | (=/= ((_.0 ERROR)) ((_.0 closure))) 170 | (sym _.0) 171 | (absento (ERROR _.1) (closure _.1))) 172 | (((cons (car (lambda (_.0) _.1)) _.2) 173 | (closure _.0 _.1 ())) 174 | (=/= ((_.0 ERROR)) ((_.0 closure))) 175 | (sym _.0) 176 | (absento (ERROR _.1) (ERROR _.2) (closure _.1) (closure _.2))) 177 | (((cons _.0 (car (lambda (_.1) _.2))) 178 | (closure _.1 _.2 ())) 179 | (=/= ((_.1 ERROR)) ((_.1 closure))) (sym _.1) 180 | (absento (ERROR _.0) (ERROR _.2) (closure _.0) (closure _.2))) 181 | ((((car (lambda (_.0) _.1)) _.2) 182 | (closure _.0 _.1 ())) 183 | (=/= ((_.0 ERROR)) ((_.0 closure))) 184 | (sym _.0) 185 | (absento (ERROR _.1) (ERROR _.2) (closure _.1) (closure _.2))) 186 | (((cdr (car (lambda (_.0) _.1))) 187 | (closure _.0 _.1 ())) 188 | (=/= ((_.0 ERROR)) ((_.0 closure))) 189 | (sym _.0) 190 | (absento (ERROR _.1) (closure _.1))))) 191 | 192 | ;; Running backwards, specifying that the generated Scheme expressions 193 | ;; must signal an UNBOUND-VARIABLE error when evaluated. We futher 194 | ;; specify that the irritant must be the (unbound) variable 'foo'. 195 | (test "11" 196 | (run 10 (q) 197 | (eval-expo q '() `(ERROR UNBOUND-VARIABLE foo))) 198 | '(foo 199 | ((cons foo _.0) 200 | (absento (ERROR _.0) (closure _.0))) 201 | ((cons _.0 foo) 202 | (absento (ERROR _.0) (closure _.0))) 203 | ((foo _.0) 204 | (absento (ERROR _.0) (closure _.0))) 205 | ((_.0 foo) (=/= ((_.0 car)) ((_.0 cdr)) ((_.0 quote))) 206 | (absento (ERROR _.0) (closure _.0))) 207 | (car foo) 208 | (cdr foo) 209 | ((cons (cons foo _.0) _.1) 210 | (absento (ERROR _.0) (ERROR _.1) 211 | (closure _.0) (closure _.1))) 212 | ((cons _.0 (cons foo _.1)) 213 | (absento (ERROR _.0) (ERROR _.1) 214 | (closure _.0) (closure _.1))) 215 | ((cons (cons _.0 foo) _.1) 216 | (absento (ERROR _.0) (ERROR _.1) 217 | (closure _.0) (closure _.1))))) 218 | 219 | ;; Running forward, demonstrating that the interpreter tries all 220 | ;; evaluation orders, and therefore can signal an UNBOUND-VARIABLE 221 | ;; error for any of the four unbound variables. 222 | (test "12" 223 | (run* (q) 224 | (eval-expo '((w x) (y z)) '() q)) 225 | '((ERROR UNBOUND-VARIABLE w) 226 | (ERROR UNBOUND-VARIABLE x) 227 | (ERROR UNBOUND-VARIABLE y) 228 | (ERROR UNBOUND-VARIABLE z))) 229 | -------------------------------------------------------------------------------- /unspecified-behavior/interp-curried-two-directions-tests.scm: -------------------------------------------------------------------------------- 1 | ;; The file 'interp-curried-two-directions.scm' contains *two* 2 | ;; relational Scheme interpreters, which differ in their evaluation 3 | ;; order for (curried) application and for evaluation order of the 4 | ;; arguments to 'cons'. 5 | ;; 6 | ;; The 'eval-left-to-righto' relation evaluates arguments in 7 | ;; left-to-right order, while the 'eval-right-to-lefto' relation 8 | ;; evaluates arguments in right-to-left order. For example, when 9 | ;; evaluating the expression (cons e1 e2), where e1 and e2 are 10 | ;; sub-expressions, 'eval-left-to-righto' will evaluate e1 before 11 | ;; evaluating e2, while 'eval-right-to-lefto' will use the opposite 12 | ;; evaluation order. 13 | ;; 14 | ;; This difference in evaluation order is only visible when an 15 | ;; expression contains an effectful expression in argument position. 16 | ;; For example, the value of the variable x after evaluating 17 | ;; (cons (set! x 5) (set! x 6)) depends on which set! is evaluated 18 | ;; second. The Scheme specification does not specify the order in 19 | ;; which expressions in argument position should be evaluated, so 20 | ;; the behavior of this example is implementation specific. 21 | ;; Vicare Scheme, Petite Chez Scheme, and Racket differ in this 22 | ;; regard: Racket evaluates left-to-right, Petite seems to evaluate 23 | ;; right-to-left, and Vicare seems to use both left-to-right and 24 | ;; right-to-left evaluation, depending on context. 25 | ;; 26 | ;; The examples in this file show how we can generate programs 27 | ;; whose behavior differs under these three implementations. 28 | (load "interp-curried-two-directions.scm") 29 | (load "../mk/test-check.scm") 30 | 31 | 32 | ;; Find a Scheme expression that evaluates to different values 33 | ;; under left-to-right and right-to-left evaluation: 34 | (test "1" 35 | (run 1 (expr v1 v2) 36 | (=/= v1 v2) 37 | (eval-left-to-righto expr v1) 38 | (eval-right-to-lefto expr v2)) 39 | '(((((lambda (_.0) 40 | (cons _.0 (set! _.0 '_.1))) 41 | '_.2) 42 | (_.2 . void) 43 | (_.1 . void)) 44 | (=/= ((_.0 cons)) ((_.0 quote)) ((_.0 set!)) ((_.0 void)) ((_.1 _.2))) 45 | (sym _.0) 46 | (absento (closure _.1) (closure _.2) 47 | (void _.1) (void _.2))))) 48 | 49 | ;; The resulting expression, 50 | ;; 51 | ;; ((lambda (_.0) 52 | ;; (cons _.0 (set! _.0 '_.1))) 53 | ;; '_.2) 54 | ;; 55 | ;; evaluates to (_.1 . #) in Vicare and Petite, 56 | ;; and evaluates to (_.2 . #) in Racket. 57 | 58 | 59 | 60 | ;; Find a Scheme expression that evaluates to either (you) or (lamp): 61 | (test "2" 62 | (run 1 (expr) 63 | (eval-left-to-righto expr '(you)) 64 | (eval-right-to-lefto expr '(lamp))) 65 | '((((lambda (_.0) 66 | (cons _.0 ((lambda (_.1) '()) (set! _.0 'lamp)))) 67 | 'you) 68 | (=/= ((_.0 cons)) ((_.0 lambda)) ((_.0 quote)) ((_.0 set!)) ((_.0 void)) 69 | ((_.1 quote)) ((_.1 void))) 70 | (sym _.0 _.1)))) 71 | 72 | ;; The resulting expression, 73 | ;; 74 | ;; ((lambda (_.0) 75 | ;; (cons _.0 ((lambda (_.1) '()) (set! _.0 'lamp)))) 76 | ;; 'you) 77 | ;; 78 | ;; evaluates to (you) in Vicare and Racket, 79 | ;; and evaluates to (lamp) in Petite. 80 | 81 | 82 | 83 | ;; Find a Scheme expression that evaluates to either (I love you) or (I love lamp): 84 | (test "3" 85 | (run 1 (expr) 86 | (eval-left-to-righto expr '(I love you)) 87 | (eval-right-to-lefto expr '(I love lamp))) 88 | '((((lambda (_.0) 89 | (_.0 (set! _.0 (lambda (_.1) '(I love lamp))))) 90 | (lambda (_.2) 91 | '(I love you))) 92 | (=/= ((_.0 lambda)) ((_.0 quote)) ((_.0 set!)) ((_.0 void)) 93 | ((_.1 quote)) ((_.1 void)) ((_.2 quote)) ((_.2 void))) 94 | (sym _.0 _.1 _.2)))) 95 | 96 | ;; The resulting expression, 97 | ;; 98 | ;; ((lambda (_.0) 99 | ;; (_.0 (set! _.0 (lambda (_.1) '(I love lamp))))) 100 | ;; (lambda (_.2) 101 | ;; '(I love you))) 102 | ;; 103 | ;; evaluates to (I love you) in Racket, 104 | ;; and evaluates to (I love lamp) in Vicare and Petite. 105 | 106 | 107 | ;; The left-to-right interpreter can also be used to generate quines. 108 | (test "quines-left-to-right" 109 | (run 1 (q) 110 | (eval-left-to-righto q q)) 111 | '((((lambda (_.0) (cons _.0 (cons (cons 'quote (cons _.0 '())) '()))) 112 | '(lambda (_.0) (cons _.0 (cons (cons 'quote (cons _.0 '())) '())))) 113 | (=/= ((_.0 closure)) ((_.0 cons)) ((_.0 quote)) ((_.0 void))) 114 | (sym _.0)))) 115 | 116 | ;; Generating quines using the right-to-left interpreter seems too inefficient 117 | ;; to come back in a reasonable time. This appears to be due to the awkward 118 | ;; way in which the interpreter evaluates '(cons e1 e2)': ideally the 119 | ;; interpreter should evaluate e1 first, which might immediately result in failure, 120 | ;; and pruning of the search tree. However, the interpreter evaluates e2 first 121 | ;; (at least logically), which may result in cdring down a list an arbitrary distance. 122 | #| 123 | (test "quines-right-to-left" 124 | (run 1 (q) 125 | (eval-right-to-lefto q q)) 126 | '((((lambda (_.0) (cons _.0 (cons (cons 'quote (cons _.0 '())) '()))) 127 | '(lambda (_.0) (cons _.0 (cons (cons 'quote (cons _.0 '())) '())))) 128 | (=/= ((_.0 closure)) ((_.0 cons)) ((_.0 quote)) ((_.0 void))) 129 | (sym _.0)))) 130 | |# 131 | -------------------------------------------------------------------------------- /unspecified-behavior/interp-curried-two-directions.scm: -------------------------------------------------------------------------------- 1 | (load "../mk/mk.scm") 2 | 3 | ;;; This version of the code uses curried lambda/application, 4 | ;;; uses 'cons' rather than 'list', and contains two interpreters: 5 | ;;; one left-to-right, and one right-to-left. 6 | 7 | 8 | (define printg 9 | (lambda (format-str . args) 10 | (lambda (c) 11 | (let ((args (walk* args (c->S c)))) 12 | (apply printf format-str args)) 13 | (newline) 14 | c))) 15 | 16 | 17 | ;;; non-directional 18 | (define-syntax extend-env 19 | (syntax-rules () 20 | [(_ x addr env) 21 | `(ext-env ,x ,addr ,env)])) 22 | 23 | (define-syntax extend-store 24 | (syntax-rules () 25 | [(_ addr val store) 26 | `(ext-store ,addr ,val ,store)])) 27 | 28 | (define lookup-varo 29 | (lambda (x env addr) 30 | (fresh (y a rest) 31 | (== `(ext-env ,y ,a ,rest) env) 32 | (conde 33 | ((== y x) (== a addr)) 34 | ((=/= y x) (lookup-varo x rest addr)))))) 35 | 36 | (define lookup-addro 37 | (lambda (addr store val) 38 | (fresh (a v rest) 39 | (== `(ext-store ,a ,v ,rest) store) 40 | (conde 41 | ((== a addr) (== v val)) 42 | ((=/= a addr) (lookup-addro addr rest val)))))) 43 | 44 | (define not-in-envo 45 | (lambda (x env) 46 | (conde 47 | ((== '() env)) 48 | ((fresh (y v rest) 49 | (== `(ext-env ,y ,v ,rest) env) 50 | (=/= y x) 51 | (not-in-envo x rest)))))) 52 | 53 | 54 | 55 | 56 | 57 | 58 | 59 | 60 | (define eval-left-to-righto 61 | (lambda (exp val) 62 | (fresh (store-out addr-out) 63 | (eval-left-to-right-expo exp '() '() 'z store-out addr-out val) 64 | (absento 'void exp)))) 65 | 66 | (define eval-left-to-right-expo 67 | (lambda (exp env store-in addr-in store-out addr-out val) 68 | (conde 69 | 70 | ((== `(quote ,val) exp) 71 | (== store-in store-out) 72 | (== addr-in addr-out) 73 | (not-in-envo 'quote env) 74 | (absento 'closure val)) 75 | 76 | ((fresh (addr) 77 | (symbolo exp) 78 | (== store-in store-out) 79 | (== addr-in addr-out) 80 | (lookup-varo exp env addr) 81 | (lookup-addro addr store-in val))) 82 | 83 | ((fresh (x body) 84 | (== `(lambda (,x) ,body) exp) 85 | (== `(closure (lambda (,x) ,body) ,env) val) 86 | (== store-in store-out) 87 | (== addr-in addr-out) 88 | (symbolo x) 89 | (not-in-envo 'lambda env))) 90 | 91 | ((fresh (x e v addr store^) 92 | (== `(set! ,x ,e) exp) 93 | (== 'void val) 94 | (== (extend-store addr v store^) store-out) 95 | (symbolo x) 96 | (not-in-envo 'set! env) 97 | (lookup-varo x env addr) 98 | (eval-left-to-right-expo e env store-in addr-in store^ addr-out v))) 99 | 100 | ((fresh (a d v-a v-d store^ addr^) 101 | (== `(cons ,a ,d) exp) 102 | (== `(,v-a . ,v-d) val) 103 | (not-in-envo 'cons env) 104 | (eval-left-to-right-expo a env store-in addr-in store^ addr^ v-a) 105 | (eval-left-to-right-expo d env store^ addr^ store-out addr-out v-d))) 106 | 107 | ((fresh (rator rand x body env^ v store^ store^^ addr^ addr^^ new-env new-store new-addr) 108 | (== `(,rator ,rand) exp) 109 | (=/= 'quote rator) 110 | (== (extend-env x addr^^ env) new-env) 111 | (== (extend-store addr^^ v store^^) new-store) 112 | (== `(s ,addr^^) new-addr) 113 | (symbolo x) 114 | (eval-left-to-right-expo rator env store-in addr-in store^ addr^ `(closure (lambda (,x) ,body) ,env^)) 115 | (eval-left-to-right-expo rand env store^ addr^ store^^ addr^^ v) 116 | (eval-left-to-right-expo body new-env new-store new-addr store-out addr-out val))) 117 | 118 | ))) 119 | 120 | 121 | 122 | 123 | 124 | 125 | 126 | 127 | 128 | 129 | 130 | (define eval-right-to-lefto 131 | (lambda (exp val) 132 | (fresh (store-out addr-out) 133 | (eval-right-to-left-expo exp '() '() 'z store-out addr-out val) 134 | (absento 'void exp)))) 135 | 136 | (define eval-right-to-left-expo 137 | (lambda (exp env store-in addr-in store-out addr-out val) 138 | (conde 139 | 140 | ((== `(quote ,val) exp) 141 | (== store-in store-out) 142 | (== addr-in addr-out) 143 | (not-in-envo 'quote env) 144 | (absento 'closure val)) 145 | 146 | ((fresh (addr) 147 | (symbolo exp) 148 | (== store-in store-out) 149 | (== addr-in addr-out) 150 | (lookup-varo exp env addr) 151 | (lookup-addro addr store-in val))) 152 | 153 | ((fresh (x body) 154 | (== `(lambda (,x) ,body) exp) 155 | (== `(closure (lambda (,x) ,body) ,env) val) 156 | (== store-in store-out) 157 | (== addr-in addr-out) 158 | (symbolo x) 159 | (not-in-envo 'lambda env))) 160 | 161 | ((fresh (x e v addr store^) 162 | (== `(set! ,x ,e) exp) 163 | (== 'void val) 164 | (== (extend-store addr v store^) store-out) 165 | (symbolo x) 166 | (not-in-envo 'set! env) 167 | (lookup-varo x env addr) 168 | (eval-right-to-left-expo e env store-in addr-in store^ addr-out v))) 169 | 170 | ((fresh (a d v-a v-d store^ addr^) 171 | (== `(cons ,a ,d) exp) 172 | (== `(,v-a . ,v-d) val) 173 | (not-in-envo 'cons env) 174 | ;; we have to be careful here: want to feed the addr-in into the a evaluation, 175 | ;; even though store-in is fed into the d evaluation 176 | (eval-right-to-left-expo d env store-in addr^ store^ addr-out v-d) 177 | (eval-right-to-left-expo a env store^ addr-in store-out addr^ v-a))) 178 | 179 | ((fresh (rator rand x body env^ v store^ store^^ addr^ addr^^ new-env new-store new-addr) 180 | (== `(,rator ,rand) exp) 181 | (=/= 'quote rator) 182 | (== (extend-env x addr^^ env) new-env) 183 | (== (extend-store addr^^ v store^^) new-store) 184 | (== `(s ,addr^^) new-addr) 185 | (symbolo x) 186 | ;; we have to be careful here: want to feed the addr-in into the rator evaluation, 187 | ;; even though store-in is fed into the rand evaluation 188 | (eval-right-to-left-expo rand env store-in addr^ store^ addr^^ v) 189 | (eval-right-to-left-expo rator env store^ addr-in store^^ addr^ `(closure (lambda (,x) ,body) ,env^)) 190 | (eval-right-to-left-expo body new-env new-store new-addr store-out addr-out val))) 191 | 192 | ))) 193 | --------------------------------------------------------------------------------