Upgrade to Pro — share decks privately, control downloads, hide ads and more …

miniKanren (clojure berlin)

miniKanren (clojure berlin)

Igor Wiedler

August 12, 2015
Tweet

More Decks by Igor Wiedler

Other Decks in Programming

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