[cl-unification-cvs] CVS cl-unification

[mantoniotti]

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