Update of /project/cl-unification/cvsroot/cl-unification In directory cl-net:/tmp/cvs-serv2661
Modified Files: substitutions.lisp Log Message: Changed some environment functions and improved the DUMP-* ones.
--- /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2011/01/18 14:48:02 1.6 +++ /project/cl-unification/cvsroot/cl-unification/substitutions.lisp 2011/02/26 09:20:45 1.7 @@ -4,6 +4,8 @@ ;;;; General CL structures unifier. ;;;; Substitution definitions. Mostly a rehash of the usual SICP stuff.
+;;;; See file COPYING for copyright licensing information. + (in-package "CL.EXT.DACF.UNIFICATION") ; DACF = Data And Control Flow.
;;;--------------------------------------------------------------------------- @@ -113,10 +115,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 push-frame (env) + (declare (type environment env)) + (pop (environment-frames env))) +
(defun empty-environment-p (env) (declare (type environment env)) @@ -187,13 +202,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 --