miniKanren (clojure berlin)

Transcript

1. miniKanren

2. @igorwhilefalse

3. prologue

4. None
5. None
6. None
7. None
8. None
9. None

10. logic programming

11. (run 1 (q) (== #t #t)) ;=> (_.0)

12. (run 1 (q) (== q 'hello)) ;=> (hello)

13. (run 1 (q) (== #t #f)) ;=> ()

14. (run 1 (q) (== q 'doughnut) (== q 'bagel)) ;=>

    ()

15. (run 1 (q) (conde [(== q 'doughnut)] [(== q 'bagel)]))

    ;=> (doughnut)

16. (run* (q) (conde [(== q 'doughnut)] [(== q 'bagel)])) ;=>

    (doughnut bagel)

17. ==

18. (run* (q) (fresh (foods d) (== foods '(maple-syrup bacon pancakes))

    (== foods `(,q . ,d)))) ;=> (maple-syrup)

19. (define append (lambda (l s) (cond ((null? l) s) (else

    (cons (car l) (append (cdr l) s))))))

20. (append '(l o v e) '(l a c e)) ;=>

    (l o v e l a c e)

21. (define appendo (lambda (l s out) (conde [(== '() l)

    (== s out)] [(fresh (a d res) (== `(,a . ,d) l) (== `(,a . ,res) out) (appendo d s res))])))

22. (run* (q) (appendo '(l o v e) '(l a c

    e) q)) ;=> ((l o v e l a c e))

23. (run* (q) (appendo '(l o v e) q '(l o

    v e l a c e))) ;=> ((l a c e))

24. (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) ()))
25. None

26. (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

27. (run 1 (q) (eval-expo '((lambda (x) x) 'me!) '() q))

    ;=> (me!)

28. (run 3 (q) (eval-expo q '() 'me!)) ;=> ('me! ;

    ((lambda (_.0) 'me!) '_.1) ; ((lambda (_.0) _.0) 'me!))

29. (run 1 (q) (eval-expo q '() q)) ;=> ((lambda (_.0)

    (list _.0 (list 'quote _.0))) ; '(lambda (_.0) (list _.0 (list 'quote _.0))))

30. ((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))))

31. why

32. core.logic gif: @bodil

33. None

34. µ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)))))

35. 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

36. Thanks •Michael (@mrb_bk) •Danielle (@daniellesucher) •Volker (@__edorian) •Will (@webyrd)

37. Questions? •minikanren.org •@igorwhilefalse