Wed Apr 15 10:05:58 UTC 2009 mantoniotti
* Added some functionality and comments.
hunk ./apply-substitution.lisp 12
-(defgeneric apply-substitution (substitution item))
+;;; apply-substitution --
+;;;
+;;; EXCLUDE-VARS are variables that will just pass through (a list for
+;;; the time being).
hunk ./apply-substitution.lisp 17
+(defgeneric apply-substitution (substitution item &optional exclude-vars))
hunk ./apply-substitution.lisp 19
-(defmethod apply-substitution ((substitution environment) (s symbol))
+
+(defmethod apply-substitution ((substitution environment) (s symbol)
+ &optional (exclude-vars ()))
+ (declare (type list exclude-vars))
hunk ./apply-substitution.lisp 25
- (multiple-value-bind (val foundp)
- (find-variable-value s substitution)
- (cond (foundp val)
- (t (warn "~S is a free variable in the current environment."
- s)
- s))))
+ (if (member s exclude-vars :test #'eq)
+ s
+ (multiple-value-bind (val foundp)
+ (find-variable-value s substitution)
+ (cond (foundp val)
+ (t (warn "~S is a free variable in the current environment."
+ s)
+ s))))
+ )
hunk ./apply-substitution.lisp 37
-(defmethod apply-substitution ((substitution environment) (l cons))
- (cons (apply-substitution substitution (first l))
- (apply-substitution substitution (rest l))))
+(defmethod apply-substitution ((substitution environment) (l cons)
+ &optional (exclude-vars ()))
+ (declare (type list exclude-vars))
+ (cons (apply-substitution substitution (first l) exclude-vars)
+ (apply-substitution substitution (rest l) exclude-vars)))
+
hunk ./apply-substitution.lisp 44
-(defmethod apply-substitution ((substitution environment) (l null))
+(defmethod apply-substitution ((substitution environment) (l null)
+ &optional exclude-vars)
+ (declare (ignore exclude-vars))
hunk ./apply-substitution.lisp 49
+
+;;; compose-substitions --
+;;; The definition is a direct translation of TPL's definition at page 318.
+;;; Usually these are done by directly composing and currying
+;;; functions in ML/Haskell derivatives, but that is just being "lazy".
+;;; The current definition may be too "eager", but the "correct"
+;;; semantics should be preserved.
+
+(defun compose-substitutions (env2 env1) ; note the order.
+ (declare (type environment env2 env1))
+
+ (loop for env1-frame in (environment-frames env1)
+ collect
+ (loop for (var . term) in (frame-bindings env1-frame)
+ collect (make-binding var (apply-substitution env2 term))
+ into result-bindings
+ finally (return (make-frame result-bindings)))
+ into frames
+ finally (return (make-environment :frames frames))))
+ [_$_]
+ [_$_]
+
+
+;;; ground-term --
+