~ashton314/microKanren

6b0c5498f25c6a61d19089a7c95ebfa89d85882a — Ashton Wiersdorf 6 months ago b1404fc
Add extensions; all code from paper now present
2 files changed, 92 insertions(+), 2 deletions(-)

M README.org
M kanren.rkt
M README.org => README.org +5 -1
@@ 99,7 99,7 @@ Here's an example from the paper showing how streams need to be interleaved and 

* Extensions

TODO
These are some syntactic sugar that make working with μKanren nicer. Most of them are macros, which would make porting these to other languages less straight-forward. But they do make working in Scheme/Racket a lot nicer. Some new non-Lisp languages like Elixir[fn:1] feature hygienic macro systems, so these features would be portable.

* Modifications



@@ 120,3 120,7 @@ Be sure to read [[http://webyrd.net/scheme-2013/papers/HemannMuKanren2013.pdf][t
Other fun links:

 - [[https://aphyr.com/posts/354-unifying-the-technical-interview][Unifying the Technical Interview]]

* Footnotes

[fn:1] Personally, I think of Elixir as a Lisp in Ruby's clothing running on the BEAM. But don't tell anyone that Lisp is quietly becoming the new hot thing in web development and some machine learning. 🤫

M kanren.rkt => kanren.rkt +87 -1
@@ 1,6 1,6 @@
#lang racket/base

(struct var (counter) #:transparent)
(struct var (name) #:transparent)
(define var=? equal?)

;;                    substitution assoc list: variable → var-or-value


@@ 103,3 103,89 @@
    ;; rest of the states in the input stream
    [else (mplus (goal (car $stream))
                 (bind (cdr $stream) goal))]))

;;; Extentions

(define-syntax Zzz
  (syntax-rules ()
    ;; This is the inverse-η-delay abstracted in a macro
    [(_ goal) (λ (subst/counter) (λ () (goal subst/counter)))]))

(define-syntax conj+
  (syntax-rules ()
    [(_ g) (Zzz g)]
    [(_ g0 gs ...) (conj (Zzz g0) (conj+ gs ...))]))

(define-syntax disj+
  (syntax-rules ()
    [(_ g) (Zzz g)]
    [(_ g0 gs ...) (disj (Zzz g0) (disj+ gs ...))]))

(define-syntax conde
  (syntax-rules ()
    [(_ (g gs ...) ...) (disj+ (conj+ g gs ...) ...)]))

(define-syntax fresh
  (syntax-rules ()
    [(_ () g gs ...) (conj+ g gs ...)]
    [(_ (x xs ...) g gs ...)
     (call/fresh (λ (x) (fresh (xs ...) g gs ...)))]))

;;; Utilities to force streams
(define (pull $stream)
  (if (procedure? $stream) (pull ($stream)) $stream))

(define (take n $stream)
  (if (zero? n) '()
      (let ([$stream (pull $stream)])
        (cond
          [(null? $stream) '()]
          [else (cons (car $stream) (take (- n 1) (cdr $stream)))]))))

(define (take-all $stream)
  (let ([$stream (pull $stream)])
    (if (null? $stream) '() (cons (car $stream) (take-all (cdr $stream))))))

;;; Reification utilities
(define (mK-reify s/c*)
  (map reify-state/1st-var s/c*))

(define (reify-state/1st-var s/c)
  (let ([v (walk* (var 'var0) (car s/c))])
    (walk* v (reify-s v '()))))

(define (reify-s v s)
  (let ([v (walk v s)])
    (cond
      [(var? v)
       (let ([n (reify-name (var-name v))])
         (cons (cons v n) s))]
      [(pair? v) (reify-s (cdr v) (reify-s (car v) s))]
      [else s])))

(define (reify-name n)
  (if (symbol? n)
      n
      (string->symbol (string-append "_" "." (number->string n)))))

(define (walk* v s)
  (let ([v (walk v s)])
    (cond
      [(var? v) v]
      [(pair? v) (cons (walk* (car v) s)
                       (walk* (cdr v) s))]
      [else v])))

(define (call/empty-state g) (g empty-state))

(define-syntax run
  (syntax-rules ()
    [(_ n (xs ...) g gs ...)
     (mK-reify (take n (call/empty-state
                        (fresh (xs ...) g gs ...))))]))

(define-syntax run*
  (syntax-rules ()
    [(_ (xs ...) g gs ...)
     (mK-reify (take-all (call/empty-state
                          (fresh (xs ...) g gs ...))))]))