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-1/substitutions.lisp new-cl-unification-1/substitutions.lisp
--- old-cl-unification-1/substitutions.lisp 2013-07-21 19:27:08.000000000 +0000
+++ new-cl-unification-1/substitutions.lisp 2013-07-21 19:27:08.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 --