anchor.diff:  ;;; File: pattern.lisp
   ;;; Description:
   
  -;;; $Id: pattern.lisp,v 1.21 2001/01/09 21:14:39 youngde Exp $
  +;;; $Id: pattern.lisp,v 1.22 2001/01/10 20:56:08 youngde Exp $
   
   (in-package :lisa)
   
  
positive.code:          :reader get-name)
     (slots :initform nil
            :accessor get-slots)
     (location :initarg :location
               :reader get-location))
    (:documentation
  
negative.code:             ((negated-rewritable-constraintp slot-value)
               (rewrite-slot (make-slot-variable) (second slot-value) t))
              ((null slot-constraint)
               (when (new-slot-binding slot-value)
                 (rewrite-slot (make-slot-variable) slot-value nil)))
              ((literalp slot-constraint)
               (rewrite-slot slot-value slot-constraint nil))
              ((negated-rewritable-constraintp slot-constraint)
               (rewrite-slot slot-value (second slot-constraint) t))
              ((variablep slot-value)
               (new-slot-binding slot-value)))
        (values))))
  
  (defun set-pattern-locality (pattern bindings)
    (labels ((is-localp (var)
               (let ((binding (lookup-binding bindings var)))
                 (cl:assert (not (null binding)) ())
                 (= (get-location binding) (get-location pattern))))
             (get-constraint-locality (constraint)
               (let ((obj (first constraint)))
                 (cond ((null obj)
                        (values t))
                       ((and (variablep obj)
                             (not (is-localp obj)))
                        (values nil))
                       (t
                        (get-constraint-locality (rest constraint))))))
             (get-slot-locality (slots)
               (let ((slot (first slots)))
                 (cond ((null slot)
                        (values t))
                       ((not (is-localp (get-value slot)))
                        (values nil))
                       ((not (get-constraint-locality (get-constraint slot)))
                        (values nil))
                       (t
                        (get-slot-locality (rest slots)))))))
      (setf (slot-value pattern 'locality)
        (get-slot-locality (get-slots pattern))))
    (values))
  
  (defmethod finalize-pattern ((self pattern) bindings)
    (mapc #'(lambda (slot)
              (canonicalize-slot self slot bindings)
              (format t "slot = ~S~%" slot))
          (get-slots self))
    (set-pattern-locality self bindings)
    (values self))
  