--- a/package-test.lisp Tue Mar 08 15:27:47 2016 +0000
+++ b/package-test.lisp Wed Mar 09 11:33:07 2016 +0000
@@ -6,6 +6,5 @@
(:use #:cl #:5am
#:bones.utils
#:bones.paip)
- (:import-from #:bones.paip)
; kill me
(:shadowing-import-from #:5am #:fail))
--- a/package.lisp Tue Mar 08 15:27:47 2016 +0000
+++ b/package.lisp Wed Mar 09 11:33:07 2016 +0000
@@ -5,5 +5,6 @@
(defpackage #:bones.paip
(:use #:cl #:defstar #:bones.utils)
(:export #:unify
- #:fail #:no-bindings))
+ #:fail #:no-bindings
+ #:*check-occurs*))
--- a/test/paip.lisp Tue Mar 08 15:27:47 2016 +0000
+++ b/test/paip.lisp Wed Mar 09 11:33:07 2016 +0000
@@ -3,6 +3,7 @@
(def-suite :bones.paip)
(in-suite :bones.paip)
+;;;; Utils
(defun alist-equal (x y)
(set-equal x y :test #'equal))
@@ -15,6 +16,8 @@
(defmacro not-unifies (x y)
`(is (eql bones.paip:fail (unify ',x ',y))))
+
+;;;; Unification
(test constant-unification
(unifies 1 1 no-bindings)
(unifies foo foo no-bindings)
@@ -44,7 +47,15 @@
(10 + (1 + 2))
((:x . 10)
(:y . 1)
- (:z . 2)))
- )
+ (:z . 2))))
-
+(test occurs-unification
+ (not-unifies :x (f :x))
+ (not-unifies :x (f (:x 1)))
+ (not-unifies :x (:x :x))
+ (not-unifies :x (:x :y))
+ (let ((*check-occurs* nil))
+ (unifies :x (f :x) ((:x . (f :x))))
+ (unifies :x (f (:x 1)) ((:x . (f (:x 1)))))
+ (unifies :x (:x :x) ((:x . (:x :x))))
+ (unifies :x (:x :y) ((:x . (:x :y))))))