1 files changed, 0 insertions, 140 deletions
diff --git a/scheme/uk.scm b/scheme/uk.scm
deleted file mode 100644
index 6d2a0f4..0000000
--- a/scheme/uk.scm
+++ /dev/null
@@ -1,140 +0,0 @@
-
-; microKanren core from 2013 microKanren paper
-
-; http://webyrd.net/scheme-2013/papers/HemannMuKanren2013.pdf
-
-
-(import (rnrs lists))
-
-
-(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 (sc)
-    (let ((s (unify u v (car sc))))
-      (if s (unit `(,s . ,(cdr sc))) mzero))))
-
-(define (unit sc) (cons sc 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 (sc)
-    (let ((c (cdr sc)))
-      ((f (var c)) `(,(car sc) . ,(+ c 1))))))
-
-(define (disj g1 g2) (lambda (sc) (mplus (g1 sc) (g2 sc))))
-(define (conj g1 g2) (lambda (sc) (bind (g1 sc) g2)))
-
-(define (mplus s1 s2)
-  (cond
-    ((null? s1) s2)
-    ((procedure? s1) (lambda () (mplus s2 (s1))))
-    (else (cons (car s1) (mplus (cdr s1) s2)))))
-
-(define (bind s g)
-  (cond
-    ((null? s) mzero)
-    ((procedure? s) (lambda () (bind (s) g)))
-    (else (mplus (g (car s)) (bind (cdr s) g)))))
-
-(define-syntax zzz
-  (syntax-rules ()
-    ((_ g) (lambda (sc) (lambda () (g sc))))))
-
-(define-syntax conj+
-  (syntax-rules ()
-    ((_ g) (zzz g))
-    ((_ g0 g ...) (conj (zzz g0) (conj+ g ...)))))
-
-(define-syntax disj+
-  (syntax-rules ()
-    ((_ g) (zzz g))
-    ((_ g0 g ...) (disj (zzz g0) (disj+ g ...)))))
-
-(define-syntax conde
-  (syntax-rules ()
-    ((_ (g0 g ...) ...) (disj+ (conj+ g0 g ...) ...))))
-
-(define-syntax fresh
-  (syntax-rules ()
-    ((_ () g0 g ...) (conj+ g0 g ...))
-    ((_ (x0 x ...) g0 g ...)
-      (call/fresh (lambda (x0) (fresh (x ...) g0 g ...))))))
-
-(define (pull s) (if (procedure? s) (pull (s)) s))
-
-(define (take-all s)
-  (let ((s (pull s)))
-    (if (null? s) '() (cons (car s) (take-all (cdr s))))))
-
-(define (take n s)
-  (if (zero? n) '()
-    (let ((s (pull s)))
-      (cond
-        ((null? s) '())
-        (else (cons (car s) (take (- n 1) (cdr s))))))))
-
-(define (mk-reify sc*)
-  (map reify-state/1st-var sc*))
-
-(define (reify-state/1st-var sc)
-  (let ((v (walk* (var 0) (car sc))))
-    (walk* v (reify-s v '()))))
-
-(define (reify-s v s)
-  (let ((v (walk v s)))
-    (cond
-      ((var? v)
-        (let ((n (reify-name (length s))))
-          (cons `(,v . ,n) s)))
-      ((pair? v) (reify-s (cdr v) (reify-s (car v) s)))
-      (else s))))
-
-(define (reify-name 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 empty-state '(() . 0))
-(define (call/empty-state g) (g empty-state))
-
-(define-syntax run
-  (syntax-rules ()
-    ((_ n (x ...) g0 g ...)
-      (mk-reify (take n (call/empty-state (fresh (x ...) g0 g ...)))))))
-
-(define-syntax run*
-  (syntax-rules ()
-    ((_ (x ...) g0 g ...)
-      (mk-reify (take-all (call/empty-state (fresh (x ...) g0 g ...)))))))
-
-(define succeed (== #f #f))
-(define fail (== #f #t))
-
-