Commit e22a22a7 authored by Marco Antoniotti's avatar Marco Antoniotti

Changed VAR-UNIFY responding to a bug report by Masayuki Takagi.

parent aa776df1
......@@ -1304,6 +1304,11 @@ otherwise an error of type UNIFICATION-FAILURE is signaled."
;;; Version with PAIP test.
;;; Bug found by Masayuki Takagi.
;;; Occur-check may happen also when the first (UNIFY VALUE PAT ENV)
;;; succeds.
#+pre-masayuki-spotting
(defun var-unify (var pat env)
(if (eq var pat)
env
......@@ -1329,6 +1334,42 @@ otherwise an error of type UNIFICATION-FAILURE is signaled."
(extend-environment var pat env))))))
(defun var-unify (var pat env)
(declare (type symbol var) ; Really (satisfies variablep).
(type environment env))
;; Case 0: VAR and PAT are the same.
(when (eq var pat)
(return-from var-unify env))
;; Case 1: VAR is a variable and it is bound in ENV.
(let ((vb (find-variable-binding var env)))
(when vb
(return-from var-unify (unify (binding-value vb) pat env))))
;; Case 2: VAR is a variable, but it is NOT bound in ENV and PAT is
;; a variable.
(when (variablep pat)
(let ((pb (find-variable-binding pat env)))
(when pb
(return-from var-unify (unify var (binding-value pb) env)))))
;; Case 3: VAR is a variable, but it is NOT bound in ENV and PAT is
;; NOT a variable. Raise an error if doing the "occur check".
(when (and *occurrence-check-p*
(occurs-in-p var pat env))
(error 'unification-failure
:format-control "Variable ~S occurs in ~S."
:format-arguments (list var pat)))
;; If we got here (no RETURN-FROM invoked), then let's extend the ENV.
(extend-environment var pat env))
#||
(defmethod occurs-in-p ((var symbol) pat env)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment