Sat Apr 2 04:01:24 UTC 2011 mantoniotti@common-lisp.net * Changed some environment functions and improved the DUMP-* ones. diff -rN -u old-cl-unification/substitutions.lisp new-cl-unification/substitutions.lisp --- old-cl-unification/substitutions.lisp 2013-11-10 20:09:45.000000000 +0000 +++ new-cl-unification/substitutions.lisp 2013-11-10 20:09:46.000000000 +0000 @@ -113,10 +113,23 @@ (make-environment :frames (list (make-frame)))) (defun copy-environment (env) + (declare (type environment env)) (make-environment :frames (copy-list (environment-frames env)))) -(defun make-shared-environment (env) - (make-environment :frames (environment-frames env))) +(defun make-shared-environment (env &optional (pushp nil)) + (declare (type environment env)) + (make-environment :frames (if pushp + (cons (make-frame) (environment-frames env)) + (environment-frames env)))) + +(defun push-frame (env) + (declare (type environment env)) + (push (make-frame) (environment-frames env))) + +(defun pop-frame (env) + (declare (type environment env)) + (pop (environment-frames env))) + (defun make-expanded-environment (base-env) (make-environment :frames (cons (make-frame) (environment-frames base-env)))) @@ -192,13 +205,20 @@ (defun dump-frame (f &optional (out *standard-output*)) (declare (type frame f)) - (terpri out) (loop for (var . value) in (frame-bindings f) - do (format out "~A~VT= ~A~%" var 8 value)) + do (format out "~&~A~VT= ~A~%" var 8 value)) ) (defun dump-environment (env &optional (out *standard-output*)) (declare (type environment env)) - (map nil #'(lambda (f) (dump-frame f out)) (environment-frames env))) + (if (empty-environment-p env) + (format out ">>> Empty unify environment ~S.~%" env) + (loop initially (format out ">>> Dumping unify environment ~S.~%" env) + for fr in (environment-frames env) + for fr-n downfrom (list-length (environment-frames env)) + do (format out ">>> Frame ~D:~%" fr-n) + do (dump-frame fr out) + do (terpri out) + ))) ;;;; end of file -- substitutions.lisp --