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

miniKanren (clojure berlin)

miniKanren (clojure berlin)

Igor Wiedler

August 12, 2015

More Decks by Igor Wiedler

Other Decks in Programming


  1. ==

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

    (cons (car l) (append (cdr l) s))))))
  3. (define appendo (lambda (l s out) (conde [(== '() l)

    (== s out)] [(fresh (a d res) (== `(,a . ,d) l) (== `(,a . ,res) out) (appendo d s res))])))
  4. (run* (q) (appendo '(l o v e) '(l a c

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

    v e l a c e))) ;=> ((l a c e))
  6. (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) ()))
  7. (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
  8. (run 3 (q) (eval-expo q '() 'me!)) ;=> ('me! ;

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

    (list _.0 (list 'quote _.0))) ; '(lambda (_.0) (list _.0 (list 'quote _.0))))
  10. ((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))))
  11. why

  12. µ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)))))
  13. 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