a6a6f6361af3

Test the occurs check
[view raw] [browse files]
author Steve Losh <steve@stevelosh.com>
date Wed, 09 Mar 2016 11:33:07 +0000
parents d08be7892816
children 52045b30aab0
branches/tags (none)
files package-test.lisp package.lisp test/paip.lisp

Changes

--- 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))))))