Structure and Interpretation of Computer Programs (87 page)

For each frame in the input stream, we use
find-assertions
(section 
4.4.4.3
) to match the pattern against all
assertions in the data base, producing a stream of extended frames,
and we use
apply-rules
(section 
4.4.4.4
) to apply
all possible rules, producing another stream of extended frames.
These two streams are combined (using
stream-append-delayed
,
section 
4.4.4.6
) to make a stream of all the ways that
the given pattern can be satisfied consistent with the original frame
(see exercise 
4.71
). The streams for the
individual input frames are combined using
stream-flatmap
(section 
4.4.4.6
) to form one large stream of all the
ways that any of the frames in the original input stream can be
extended to produce a match with the given pattern.

And
queries are handled as illustrated in
figure 
4.5
by the
conjoin
procedure.
Conjoin
takes as inputs the conjuncts and the frame stream and
returns the stream of extended frames. First,
conjoin
processes
the stream of frames to find the stream of all possible frame extensions
that satisfy the first query in the conjunction. Then, using this as the new
frame stream, it recursively applies
conjoin
to the rest of the
queries.

(define (conjoin conjuncts frame-stream)
  (if (empty-conjunction? conjuncts)
      frame-stream
      (conjoin (rest-conjuncts conjuncts)
               (qeval (first-conjunct conjuncts)
                      frame-stream))))

The expression

(put 'and 'qeval conjoin)

sets up
qeval
to dispatch to
conjoin
when an
and
form is encountered.

Or
queries are handled similarly, as shown in
figure 
4.6
. The output streams for the various
disjuncts of the
or
are computed separately and merged using the
interleave-delayed
procedure from section 
4.4.4.6
.
(See exercises 
4.71
and 
4.72
.)

(define (disjoin disjuncts frame-stream)
  (if (empty-disjunction? disjuncts)
      the-empty-stream
      (interleave-delayed
       (qeval (first-disjunct disjuncts) frame-stream)
       (delay (disjoin (rest-disjuncts disjuncts)
                       frame-stream)))))
(put 'or 'qeval disjoin)

The predicates and selectors for the syntax of conjuncts and disjuncts
are given in section 
4.4.4.7
.

Not
is handled by the method outlined in
section 
4.4.2
. We attempt to extend each frame in
the input stream to satisfy the query being negated, and we include a
given frame in the output stream only if it cannot be extended.

(define (negate operands frame-stream)
  (stream-flatmap
   (lambda (frame)
     (if (stream-null? (qeval (negated-query operands)
                              (singleton-stream frame)))
         (singleton-stream frame)
         the-empty-stream))
   frame-stream))
(put 'not 'qeval negate)

Lisp-value
is a filter similar to
not
. Each frame in the
stream is used to instantiate the variables in the pattern, the
indicated predicate is applied, and the frames for which the predicate
returns false are filtered out of the input stream. An error results
if there are unbound pattern variables.

(define (lisp-value call frame-stream)
  (stream-flatmap
   (lambda (frame)
     (if (execute
          (instantiate
           call
           frame
           (lambda (v f)
             (error "Unknown pat var -- LISP-VALUE" v))))
         (singleton-stream frame)
         the-empty-stream))
   frame-stream))
(put 'lisp-value 'qeval lisp-value)

Execute
, which applies the predicate to the arguments, must
eval
the predicate expression to get the procedure to apply.
However, it must not evaluate the arguments, since they are already
the actual arguments, not expressions whose evaluation (in Lisp) will
produce the arguments. Note that
execute
is implemented using
eval
and
apply
from the underlying Lisp system.

(define (execute exp)
  (apply (eval (predicate exp) user-initial-environment)
         (args exp)))

The
always-true
special form provides for a query that is always
satisfied. It ignores its contents (normally empty) and simply passes
through all the frames in the input stream.
Always-true
is used
by the
rule-body
selector (section 
4.4.4.7
)
to provide bodies for rules that were
defined without bodies (that is, rules whose conclusions are always
satisfied).

(define (always-true ignore frame-stream) frame-stream)
(put 'always-true 'qeval always-true)

The selectors that define the syntax of
not
and
lisp-value
are given in section 
4.4.4.7
.

Find-assertions
, called by
simple-query
(section 
4.4.4.2
), takes as input a pattern and a frame.
It returns a stream of frames, each extending the given one by a
data-base match of the given pattern. It uses
fetch-assertions
(section 
4.4.4.5
) to get a stream of all the assertions in
the data base that should be checked for a match against the pattern
and the frame. The reason for
fetch-assertions
here is that we
can often apply simple tests that will eliminate many of the entries
in the data base from the pool of candidates for a successful match.
The system would still work if we eliminated
fetch-assertions
and simply checked a stream of all assertions in the data base, but
the computation would be less efficient because we would need to make
many more calls to the matcher.

(define (find-assertions pattern frame)
  (stream-flatmap (lambda (datum)
                    (check-an-assertion datum pattern frame))
                  (fetch-assertions pattern frame)))

Check-an-assertion
takes as arguments a pattern, a data object
(assertion), and a frame and returns either a one-element stream
containing the extended frame or
the-empty-stream
if the match
fails.

(define (check-an-assertion assertion query-pat query-frame)
  (let ((match-result
         (pattern-match query-pat assertion query-frame)))
    (if (eq? match-result 'failed)
        the-empty-stream
        (singleton-stream match-result))))

The basic pattern matcher returns either the symbol
failed
or an
extension of the given frame. The basic idea of the matcher is to
check the pattern against the data, element by element, accumulating
bindings for the pattern variables. If the pattern and the data
object are the same, the match succeeds and we return the frame of
bindings accumulated so far. Otherwise, if the pattern is a variable
we extend the current frame by binding the variable to the data, so
long as this is consistent with the bindings already in the frame. If
the pattern and the data are both pairs, we (recursively) match the
car
of the pattern against the
car
of the data to produce
a frame; in this frame we then match the
cdr
of the pattern
against the
cdr
of the data. If none of these cases are
applicable, the match fails and we return the symbol
failed
.

(define (pattern-match pat dat frame)
  (cond ((eq? frame 'failed) 'failed)
        ((equal? pat dat) frame)
        ((var? pat) (extend-if-consistent pat dat frame))
        ((and (pair? pat) (pair? dat))
         (pattern-match (cdr pat)
                        (cdr dat)
                        (pattern-match (car pat)
                                       (car dat)
                                       frame)))
        (else 'failed)))

Here is the procedure that extends a frame by adding a new binding, if
this is consistent with the bindings already in the frame:

(define (extend-if-consistent var dat frame)
  (let ((binding (binding-in-frame var frame)))
    (if binding
        (pattern-match (binding-value binding) dat frame)
        (extend var dat frame))))

If there is no binding for the variable in the frame, we simply add
the binding of the variable to the data. Otherwise we match, in the
frame, the data against the value of the variable in the frame. If
the stored value contains only constants, as it must if it was stored
during pattern matching by
extend-if-consistent
, then the match
simply tests whether the stored and new values are the same. If so,
it returns the unmodified frame; if not, it returns a failure
indication. The stored value may, however, contain pattern variables
if it was stored during unification (see section 
4.4.4.4
).
The recursive match of the stored pattern against the new data will add or
check bindings for the variables in this pattern. For example,
suppose we have a frame in which
?x
is bound to
(f ?y)
and
?y
is unbound, and we wish to augment this frame by a binding of
?x
to
(f b)
. We look up
?x
and find that it is
bound to
(f ?y)
. This leads us to match
(f ?y)
against
the proposed new value
(f b)
in the same frame. Eventually
this match extends the frame by adding a binding of
?y
to
b
.
?X
remains bound to
(f ?y)
. We never modify a stored
binding and we never store more than one binding for a given variable.

The procedures used by
extend-if-consistent
to manipulate
bindings are defined in section 
4.4.4.8
.

If a pattern contains a dot followed by a pattern variable, the
pattern variable matches the rest of the data list (rather than the
next element of the data list), just as one would expect with the
dotted-tail notation described in exercise 
2.20
.
Although the pattern matcher we have just implemented doesn't look for
dots, it does behave as we want. This is because the Lisp
read
primitive, which is used by
query-driver-loop
to read the query
and represent it as a list structure, treats dots in a special way.

When
read
sees a dot, instead of making the next item be the
next element of a list (the
car
of a
cons
whose
cdr
will be the rest of the list) it makes the next item be the
cdr
of the list structure. For example, the list structure produced by
read
for the pattern
(computer ?type)
could be constructed
by evaluating the expression
(cons 'computer (cons '?type '()))
,
and that for
(computer . ?type)
could be constructed by
evaluating the expression
(cons 'computer '?type)
.

Thus, as
pattern-match
recursively compares
car
s and
cdr
s of a data list and a pattern that had a dot, it eventually
matches the variable after the dot (which is a
cdr
of the
pattern) against a sublist of the data list, binding the variable to
that list. For example, matching the pattern
(computer . ?type)
against
(computer programmer trainee)
will match
?type
against the
list
(programmer trainee)
.

Apply-rules
is the rule analog of
find-assertions
(section 
4.4.4.3
). It
takes as input a pattern and a frame, and it forms a stream of
extension frames by applying rules from the data base.
Stream-flatmap
maps
apply-a-rule
down the stream of possibly
applicable rules (selected by
fetch-rules
, section 
4.4.4.5
)
and combines the resulting streams of frames.

(define (apply-rules pattern frame)
  (stream-flatmap (lambda (rule)
                    (apply-a-rule rule pattern frame))
                  (fetch-rules pattern frame)))

Apply-a-rule
applies rules using the method outlined in
section
4.4.2
. It first augments its argument
frame by unifying the rule conclusion with the pattern in the given
frame. If this succeeds, it evaluates the rule body in this new
frame.

Before any of this happens, however, the program renames all the
variables in the rule with unique new names. The reason for this is
to prevent the variables for different rule applications from becoming
confused with each other. For instance, if two rules both use a
variable named
?x
, then each one may add a binding for
?x
to the frame when it is applied. These two
?x
's have nothing to
do with each other, and we should not be fooled into thinking that the
two bindings must be consistent. Rather than rename variables, we
could devise a more clever environment structure; however, the
renaming approach we have chosen here is the most straightforward,
even if not the most efficient. (See
exercise 
4.79
.) Here is the
apply-a-rule
procedure:

(define (apply-a-rule rule query-pattern query-frame)
  (let ((clean-rule (rename-variables-in rule)))
    (let ((unify-result
           (unify-match query-pattern
                        (conclusion clean-rule)
                        query-frame)))
      (if (eq? unify-result 'failed)
          the-empty-stream
          (qeval (rule-body clean-rule)
                 (singleton-stream unify-result))))))