miniKanren (clojure berlin)

miniKanren (clojure berlin)

A4b95be2145cc46f891707b6db9dd82d?s=128

Igor Wiedler

August 12, 2015
Tweet

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