Structure and Interpretation of Computer Programs (88 page)

The selectors
rule-body
and
conclusion
that extract parts
of a rule are defined in section 
4.4.4.7
.

We generate unique variable names by associating a unique identifier
(such as a number) with each rule application and combining this
identifier with the original variable names. For example, if the
rule-application identifier is 7, we might change each
?x
in
the rule to
?x-7
and each
?y
in the rule to
?y-7
.
(
Make-new-variable
and
new-rule-application-id
are
included with the syntax procedures in section 
4.4.4.7
.)

(define (rename-variables-in rule)
  (let ((rule-application-id (new-rule-application-id)))
    (define (tree-walk exp)
      (cond ((var? exp)
             (make-new-variable exp rule-application-id))
            ((pair? exp)
             (cons (tree-walk (car exp))
                   (tree-walk (cdr exp))))
            (else exp)))
    (tree-walk rule)))

The unification algorithm is implemented as a procedure that takes as
inputs two patterns and a frame and returns either the extended frame
or the symbol
failed
.
The unifier is like the pattern matcher except that it is
symmetrical – variables are allowed on both sides of the match.
Unify-match
is basically the same as
pattern-match
,
except that there is extra code (marked “
***
” below) to handle
the case where the object on the right side of the match is a variable.

(define (unify-match p1 p2 frame)
  (cond ((eq? frame 'failed) 'failed)
        ((equal? p1 p2) frame)
        ((var? p1) (extend-if-possible p1 p2 frame))
        ((var? p2) (extend-if-possible p2 p1 frame))  
; ***
        ((and (pair? p1) (pair? p2))
         (unify-match (cdr p1)
                      (cdr p2)
                      (unify-match (car p1)
                                   (car p2)
                                   frame)))
        (else 'failed)))

In unification, as in one-sided pattern matching, we want to accept a
proposed extension of the frame only if it is consistent with existing
bindings. The procedure
extend-if-possible
used in unification
is the same as the
extend-if-consistent
used in pattern matching
except for two special checks, marked “
***
” in the program
below. In the first case, if the variable we are trying to match is
not bound, but the value we are trying to match it with
is itself a (different) variable, it is
necessary to check to see if the value is bound, and if so, to match
its value. If both parties to the match are unbound, we may bind
either to the other.

The second check deals with attempts to bind a variable to a pattern
that includes that variable. Such a situation can occur whenever a
variable is repeated in both patterns. Consider, for example,
unifying the two patterns
(?x ?x)
and
(?y
<
expression involving
?y
>)
in a frame where both
?x
and
?y
are unbound. First
?x
is matched
against
?y
, making a binding of
?x
to
?y
. Next, the same
?x
is matched against the given expression
involving
?y
.
Since
?x
is already bound to
?y
, this
results in matching
?y
against the expression.
If we think of the
unifier as finding a set of values for the pattern variables that make
the patterns the same, then these patterns imply instructions to find
a
?y
such that
?y
is equal to the expression involving
?y
.
There is no general method for solving such
equations, so we reject such bindings; these cases are recognized by
the predicate
depends-on?
.
⁸⁰
On the other hand, we do not want to reject attempts
to bind a variable to itself. For example, consider unifying
(?x ?x)
and
(?y ?y)
. The second attempt to bind
?x
to
?y
matches
?y
(the stored value of
?x
) against
?y
(the new value of
?x
). This is taken care of by the
equal?
clause
of
unify-match
.

(define (extend-if-possible var val frame)
  (let ((binding (binding-in-frame var frame)))
    (cond (binding
           (unify-match
            (binding-value binding) val frame))
          ((var? val)                      
; ***
           (let ((binding (binding-in-frame val frame)))
             (if binding
                 (unify-match
                  var (binding-value binding) frame)
                 (extend var val frame))))
          ((depends-on? val var frame)     
; ***
           'failed)
          (else (extend var val frame)))))

Depends-on?
is a predicate that tests whether an expression
proposed to be the value of a pattern variable depends on the variable.
This must be done relative to the current frame because the expression
may contain occurrences of a variable that already has a value that
depends on our test variable. The structure of
depends-on?
is a
simple recursive tree walk in which we substitute for the values of
variables whenever necessary.

(define (depends-on? exp var frame)
  (define (tree-walk e)
    (cond ((var? e)
           (if (equal? var e)
               true
               (let ((b (binding-in-frame e frame)))
                 (if b
                     (tree-walk (binding-value b))
                     false))))
          ((pair? e)
           (or (tree-walk (car e))
               (tree-walk (cdr e))))
          (else false)))
  (tree-walk exp))

One important problem in designing logic programming languages is that
of arranging things so that as few irrelevant data-base entries as
possible will be examined in checking a given pattern. In our
system, in addition to storing all assertions in one big stream,
we store all assertions whose
car
s are constant symbols
in separate streams, in a table indexed by the symbol. To fetch an
assertion that may match a pattern, we first check to see if the
car
of the pattern is a constant symbol. If so, we return (to be
tested using the matcher) all the stored assertions that have the same
car
. If the pattern's
car
is not a constant symbol, we
return all the stored assertions. Cleverer methods could also take
advantage of information in the frame, or try also to optimize the
case where the
car
of the pattern is not a constant symbol. We
avoid building our criteria for indexing (using the
car
,
handling only the case of constant symbols) into the program; instead
we call on predicates and selectors that embody our criteria.

(define THE-ASSERTIONS the-empty-stream)
(define (fetch-assertions pattern frame)
  (if (use-index? pattern)
      (get-indexed-assertions pattern)
      (get-all-assertions)))
(define (get-all-assertions) THE-ASSERTIONS)
(define (get-indexed-assertions pattern)
  (get-stream (index-key-of pattern) 'assertion-stream))

Get-stream
looks up a stream in the table and returns an empty
stream if nothing is stored there.

(define (get-stream key1 key2)
  (let ((s (get key1 key2)))
    (if s s the-empty-stream)))

Rules are stored similarly, using the
car
of the rule
conclusion. Rule conclusions are arbitrary patterns, however, so they
differ from assertions in that they can contain variables. A pattern
whose
car
is a constant symbol can match rules whose conclusions
start with a variable as well as rules whose conclusions have the same
car
. Thus, when fetching rules that might match a pattern whose
car
is a constant symbol we fetch all rules whose conclusions
start with a variable as well as those whose conclusions have the same
car
as the pattern. For this purpose we store all rules whose
conclusions start with a variable in a separate stream in our table,
indexed by the symbol
?
.

(define THE-RULES the-empty-stream)
(define (fetch-rules pattern frame)
  (if (use-index? pattern)
      (get-indexed-rules pattern)
      (get-all-rules)))
(define (get-all-rules) THE-RULES)
(define (get-indexed-rules pattern)
  (stream-append
   (get-stream (index-key-of pattern) 'rule-stream)
   (get-stream '? 'rule-stream)))

Add-rule-or-assertion!
is used by
query-driver-loop
to
add assertions and rules to the data base. Each item is stored in the
index, if appropriate, and in a stream of all assertions or rules in
the data base.

(define (add-rule-or-assertion! assertion)
  (if (rule? assertion)
      (add-rule! assertion)
      (add-assertion! assertion)))
(define (add-assertion! assertion)
  (store-assertion-in-index assertion)
  (let ((old-assertions THE-ASSERTIONS))
    (set! THE-ASSERTIONS
          (cons-stream assertion old-assertions))
    'ok))
(define (add-rule! rule)
  (store-rule-in-index rule)
  (let ((old-rules THE-RULES))
    (set! THE-RULES (cons-stream rule old-rules))
    'ok))

To actually store an assertion or a rule, we check to see if it can be
indexed. If so, we store it in the appropriate stream.

(define (store-assertion-in-index assertion)
  (if (indexable? assertion)
      (let ((key (index-key-of assertion)))
        (let ((current-assertion-stream
               (get-stream key 'assertion-stream)))
          (put key
               'assertion-stream
               (cons-stream assertion
                            current-assertion-stream))))))
(define (store-rule-in-index rule)
  (let ((pattern (conclusion rule)))
    (if (indexable? pattern)
        (let ((key (index-key-of pattern)))
          (let ((current-rule-stream
                 (get-stream key 'rule-stream)))
            (put key
                 'rule-stream
                 (cons-stream rule
                              current-rule-stream)))))))

The following procedures define how the data-base index is used. A
pattern (an assertion or a rule conclusion) will be stored in the
table if it starts with a variable or a constant symbol.

(define (indexable? pat)
  (or (constant-symbol? (car pat))
      (var? (car pat))))

The key under which a pattern is stored in the table is either
?
(if it starts with a variable) or the constant symbol with which
it starts.

(define (index-key-of pat)
  (let ((key (car pat)))
    (if (var? key) '? key)))

The index will be used to retrieve items that might match a pattern if
the pattern starts with a constant symbol.

(define (use-index? pat)
  (constant-symbol? (car pat)))

Exercise 4.70.
  What is the purpose of the
let
bindings in the procedures
add-assertion!
and
add-rule!
? What would be wrong with the
following implementation of
add-assertion!
?
Hint: Recall the definition of the infinite stream of ones in
section 
3.5.2
:
(define ones (cons-stream 1 ones))
.

(define (add-assertion! assertion)
  (store-assertion-in-index assertion)
  (set! THE-ASSERTIONS
        (cons-stream assertion THE-ASSERTIONS))
  'ok)

The query system uses a few stream operations that were not presented
in chapter 3.

Stream-append-delayed
and
interleave-delayed
are just like
stream-append
and
interleave
(section 
3.5.3
),
except that they take a delayed argument (like the
integral
procedure in section 
3.5.4
).
This postpones looping in some cases (see exercise 
4.71
).

(define (stream-append-delayed s1 delayed-s2)
  (if (stream-null? s1)
      (force delayed-s2)
      (cons-stream
       (stream-car s1)
       (stream-append-delayed (stream-cdr s1) delayed-s2))))
(define (interleave-delayed s1 delayed-s2)
  (if (stream-null? s1)
      (force delayed-s2)
      (cons-stream
       (stream-car s1)
       (interleave-delayed (force delayed-s2)
                           (delay (stream-cdr s1))))))

Stream-flatmap
, which is used throughout the query evaluator to
map a procedure over a stream of frames and combine the resulting
streams of frames, is the stream analog of the
flatmap
procedure
introduced for ordinary lists in section 
2.2.3
.
Unlike ordinary
flatmap
, however, we accumulate the streams with
an interleaving process, rather than simply appending them (see
exercises 
4.72
and  
4.73
).

(define (stream-flatmap proc s)
  (flatten-stream (stream-map proc s)))
(define (flatten-stream stream)
  (if (stream-null? stream)
      the-empty-stream
      (interleave-delayed
       (stream-car stream)
       (delay (flatten-stream (stream-cdr stream))))))

The evaluator also uses the following simple procedure
to generate a stream consisting of a single element:

(define (singleton-stream x)
  (cons-stream x the-empty-stream))

Type
and
contents
, used by
qeval
(section 
4.4.4.2
), specify that a
special form is identified by the symbol in its
car
.
They are the same as the
type-tag
and
contents
procedures in
section 
2.4.2
, except for the error message.