Upgrade to Pro
— share decks privately, control downloads, hide ads and more …
Speaker Deck
Speaker Deck
PRO
Sign in
Sign up
for free
miniKanren (clojure berlin)
Igor Wiedler
August 12, 2015
Programming
1
170
miniKanren (clojure berlin)
Igor Wiedler
August 12, 2015
Tweet
Share
More Decks by Igor Wiedler
See All by Igor Wiedler
igorw
3
830
igorw
0
76
igorw
0
79
igorw
0
150
igorw
0
150
igorw
1
190
igorw
0
150
igorw
1
680
igorw
7
1.1k
Other Decks in Programming
See All in Programming
manfredsteyer
PRO
0
160
emmaglorypraise
0
140
mackee
0
670
mihyaeru21
0
370
afilina
PRO
0
150
satoshun
0
120
sters
2
140
tkow
1
130
tetsukick
0
180
gernotstarke
0
390
numeroanddev
1
240
grapecity_dev
0
200
Featured
See All Featured
cherdarchuk
71
260k
chriscoyier
779
240k
edds
56
9.4k
pedronauck
652
110k
orderedlist
PRO
328
36k
carmenhchung
31
1.5k
jponch
103
5.1k
gr2m
83
11k
tanoku
258
24k
paulrobertlloyd
71
3.6k
aarron
257
36k
matthewcrist
73
7.5k
Transcript
miniKanren
@igorwhilefalse
prologue
None
None
None
None
None
None
logic programming
(run 1 (q) (== #t #t)) ;=> (_.0)
(run 1 (q) (== q 'hello)) ;=> (hello)
(run 1 (q) (== #t #f)) ;=> ()
(run 1 (q) (== q 'doughnut) (== q 'bagel)) ;=>
()
(run 1 (q) (conde [(== q 'doughnut)] [(== q 'bagel)]))
;=> (doughnut)
(run* (q) (conde [(== q 'doughnut)] [(== q 'bagel)])) ;=>
(doughnut bagel)
==
(run* (q) (fresh (foods d) (== foods '(maple-syrup bacon pancakes))
(== foods `(,q . ,d)))) ;=> (maple-syrup)
(define append (lambda (l s) (cond ((null? l) s) (else
(cons (car l) (append (cdr l) s))))))
(append '(l o v e) '(l a c e)) ;=>
(l o v e l a c e)
(define appendo (lambda (l s out) (conde [(== '() l)
(== s out)] [(fresh (a d res) (== `(,a . ,d) l) (== `(,a . ,res) out) (appendo d s res))])))
(run* (q) (appendo '(l o v e) '(l a c
e) q)) ;=> ((l o v e l a c e))
(run* (q) (appendo '(l o v e) q '(l o
v e l a c e))) ;=> ((l a c e))
(run* (q r) (appendo q r '(l o v e)))
;=> ((() (l o v e)) ; ((l) (o v e)) ; ((l o) (v e)) ; ((l o v) (e)) ; ((l o v e) ()))
None
(define eval-expo (lambda (exp env val) (conde ((fresh (v) (==
`(quote ,v) exp) (not-in-envo 'quote env) (noo 'closure v) (== v val))) ((fresh (a*) (== `(list . ,a*) exp) (not-in-envo 'list env) (noo 'closure a*) (proper-listo a* env val))) ((symbolo exp) (lookupo exp env val)) ((fresh (rator rand x body env^ a) (== `(,rator ,rand) exp) (eval-expo rator env `(closure ,x ,body ,env^)) (eval-expo rand env a) (eval-expo body `((,x . ,a) . ,env^) val))) ((fresh (x body) (== `(lambda (,x) ,body) exp) (symbolo x) (not-in-envo 'lambda env) (== `(closure ,x ,body ,env) val)))))) (define not-in-envo (lambda (x env) (conde ((fresh (y v rest) (== `((,y . ,v) . ,rest) env) (=/= y x) (not-in-envo x rest))) ((== '() env))))) (define proper-listo (lambda (exp env val) (conde ((== '() exp) (== '() val)) ((fresh (a d t-a t-d) (== `(,a . ,d) exp) (== `(,t-a . ,t-d) val) (eval-expo a env t-a) (proper-listo d env t-d)))))) (define lookupo (lambda (x env t) (fresh (rest y v) (== `((,y . ,v) . ,rest) env) (conde ((== y x) (== v t)) ((=/= y x) (lookupo x rest t)))))) github.com/webyrd/quines
(run 1 (q) (eval-expo '((lambda (x) x) 'me!) '() q))
;=> (me!)
(run 3 (q) (eval-expo q '() 'me!)) ;=> ('me! ;
((lambda (_.0) 'me!) '_.1) ; ((lambda (_.0) _.0) 'me!))
(run 1 (q) (eval-expo q '() q)) ;=> ((lambda (_.0)
(list _.0 (list 'quote _.0))) ; '(lambda (_.0) (list _.0 (list 'quote _.0))))
((lambda (_.0) (list _.0 (list 'quote _.0))) '(lambda (_.0) (list
_.0 (list 'quote _.0)))) ;=> ((lambda (_.0) (list _.0 (list 'quote _.0))) ; '(lambda (_.0) (list _.0 (list 'quote _.0))))
why
core.logic gif: @bodil
None
µKanren (define (var c) (vector c)) (define (var? x) (vector?
x)) (define (var=? x1 x2) (= (vector-ref x1 0) (vector-ref x2 0))) (define (walk u s) (let ((pr (and (var? u) (assp (lambda (v) (var=? u v)) s)))) (if pr (walk (cdr pr) s) u))) (define (ext-s x v s) `((,x . ,v) . ,s)) (define (== u v) (lambda (s/c) (let ((s (unify u v (car s/c)))) (if s (unit `(,s . ,(cdr s/c))) mzero)))) (define (unit s/c) (cons s/c mzero)) (define mzero '()) (define (unify u v s) (let ((u (walk u s)) (v (walk v s))) (cond ((and (var? u) (var? v) (var=? u v)) s) ((var? u) (ext-s u v s)) ((var? v) (ext-s v u s)) ((and (pair? u) (pair? v)) (let ((s (unify (car u) (car v) s))) (and s (unify (cdr u) (cdr v) s)))) (else (and (eqv? u v) s))))) (define (call/fresh f) (lambda (s/c) (let ((c (cdr s/c))) ((f (var c)) `(,(car s/c) . ,(+ c 1)))))) (define (disj g1 g2) (lambda (s/c) (mplus (g1 s/c) (g2 s/c)))) (define (conj g1 g2) (lambda (s/c) (bind (g1 s/c) g2))) (define (mplus $1 $2) (cond ((null? $1) $2) ((procedure? $1) (lambda () (mplus $2 ($1)))) (else (cons (car $1) (mplus (cdr $1) $2))))) (define (bind $ g) (cond ((null? $) mzero) ((procedure? $) (lambda () (bind ($) g))) (else (mplus (g (car $)) (bind (cdr $) g)))))
References (1) The Reasoned Schemer Daniel Friedman, William Byrd, Oleg
Kiselyov (2) Quine Generation via Relational Interpreters William Byrd, Eric Holk, Daniel Friedman (3) µKanren Jason Hemann, Daniel Friedman (4) Propositions as Types Philip Wadler
Thanks •Michael (@mrb_bk) •Danielle (@daniellesucher) •Volker (@__edorian) •Will (@webyrd)
Questions? •minikanren.org •@igorwhilefalse