miniKanren (clojure berlin)

Transcript

1. miniKanren
   

   View Slide

2. @igorwhilefalse
   

   View Slide

3. prologue
   

   View Slide

4. View Slide

5. View Slide

6. View Slide

7. View Slide

8. View Slide

9. View Slide

10. logic programming
    

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

17. ==
    

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

23. (run* (q)
    (appendo '(l o v e) q
    '(l o v e l a c e)))
    ;=> ((l a c e))
    

    View Slide

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

    View Slide

25. View Slide

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
    

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

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

    View Slide

31. why
    

    View Slide

32. core.logic
    gif: @bodil
    

    View Slide

33. View Slide

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

    View Slide

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
    

    View Slide

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

    View Slide

37. Questions?
    •minikanren.org
    •@igorwhilefalse
    

    View Slide