Wed Apr 15 10:17:48 UTC 2009 mantoniotti
* Added some functionality to extract all variables and/or all values
Added some functionality to extract all variables and/or all values
from an environment or a frame.
diff -rN -u old-cl-unification-1/substitutions.lisp new-cl-unification-1/substitutions.lisp
--- old-cl-unification-1/substitutions.lisp 2013-07-21 20:06:19.000000000 +0000
+++ new-cl-unification-1/substitutions.lisp 2013-07-21 20:06:20.000000000 +0000
@@ -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 --