a6a6f6361af3
Test the occurs check
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))))))