[cl-unification-cvs] CVS cl-unification

[mantoniotti]

Update of /project/cl-unification/cvsroot/cl-unification
In directory cl-net:/tmp/cvs-serv27503

Modified Files:
	substitutions.lisp 
Log Message:
Added some functionality to extract all variables and/or all values
from an environment or a frame.


--- /project/cl-unification/cvsroot/cl-unification/substitutions.lisp	2008/07/13 13:10:48	1.4
+++ /project/cl-unification/cvsroot/cl-unification/substitutions.lisp	2009/04/15 10:17:48	1.5
@@ -39,6 +39,11 @@
   (setf (cdr b) v))
 
 
+(defun bindings-values (bindings) (mapcar #'cdr bindings))
+
+(defun bindings-keys (bindings) (mapcar #'car bindings))
+
+
 
 (define-condition unification-variable-unbound (unbound-variable)
   ()
@@ -51,7 +56,7 @@
 ;;;---------------------------------------------------------------------------
 ;;; Frames.
 
-(defstruct frame
+(defstruct (frame (:constructor make-frame (&optional bindings)))
   (bindings () :type bindings))
 
 (defun empty-frame-p (f)
@@ -72,6 +77,13 @@
         (values (cdr b) t)
         (values nil nil))))
 
+(defun frame-variables (frame)
+  (mapcar 'binding-variable (frame-bindings frame)))
+
+
+(defun frame-values (frame)
+  (mapcar 'binding-value (frame-bindings frame)))
+
 
 ;;;---------------------------------------------------------------------------
 ;;; Environments.
@@ -106,10 +118,12 @@
 (defun make-shared-environment (env)
   (make-environment :frames (environment-frames env)))
 
-(defun empty-environment-p (env &aux (env-frames (environment-frames env)))
+(defun empty-environment-p (env)
   (declare (type environment env))
-  (and (= 1 (list-length env-frames))
-       (empty-frame-p (first env-frames))))
+  (let ((env-frames (environment-frames env)))
+    (declare (type list env-frames))
+    (and (= 1 (list-length env-frames))
+         (empty-frame-p (first env-frames)))))
 
 (defparameter *null-environment* (make-empty-environment))
 
@@ -131,19 +145,43 @@
 
 
 
-(defun extend-environment (var pat env)
+(defun extend-environment (var pat &optional (env (make-empty-environment)))
   (let ((first-frame (first-frame env)))
     (setf (frame-bindings first-frame)
           (extend-bindings var pat (frame-bindings first-frame)))
     env))
 
 
+(defun fill-environment (vars pats &optional (env (make-empty-environment)))
+  (map nil (lambda (v p) (extend-environment v p env)) vars pats)
+  env)
+
+
+(defun fill-environment* (vars-pats &optional (env (make-empty-environment)))
+  (loop for (v . p) in vars-pats do (extend-environment v p env))
+  env)
+
+
+(declaim (inline v?))
+(declaim (ftype (function (symbol environment &optional boolean)
+                          (values t boolean))
+                find-variable-value
+                v?))
+
 (defun v? (s env &optional (plain-symbol-p nil))
   (find-variable-value (if plain-symbol-p
                            (make-var-name s)
                            s)
                        env))
-                           
+
+
+(defun environment-variables (env)
+  (mapcan #'frame-variables (environment-frames env)))
+
+(defun environment-values (env)
+  (mapcan #'frame-values (environment-frames env)))
+
+
 
 
 ;;;; end of file -- substitutions.lisp --