Exercise 4.70 · 习题

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 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)

4.4.4.6Stream Operations

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 (3.5.3), except that
they take a delayed argument (like the integral procedure in
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 2.2.3. Unlike ordinary flatmap, however, we
accumulate the streams with an interleaving process, rather than simply
appending them (see Exercise 4.72 and Exercise 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))

4.4.4.7Query Syntax Procedures

Type and contents, used by qeval (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
2.4.2, except for the error message.

(define (type exp)
(if (pair? exp)
(car exp)
(error "Unknown expression TYPE"
exp)))

(define (contents exp)
(if (pair? exp)
(cdr exp)
(error "Unknown expression CONTENTS"
exp)))

The following procedures, used by query-driver-loop (in
4.4.4.1), specify that rules and assertions are added to the data base by
expressions of the form (assert! ⟨rule-or-assertion⟩):

(define (assertion-to-be-added? exp)
(eq? (type exp) 'assert!))

(define (add-assertion-body exp)
(car (contents exp)))

Here are the syntax definitions for the and, or, not, and
lisp-value special forms (4.4.4.2):

(define (empty-conjunction? exps) (null? exps))
(define (first-conjunct exps) (car exps))
(define (rest-conjuncts exps) (cdr exps))
(define (empty-disjunction? exps) (null? exps))
(define (first-disjunct exps) (car exps))
(define (rest-disjuncts exps) (cdr exps))
(define (negated-query exps) (car exps))
(define (predicate exps) (car exps))
(define (args exps) (cdr exps))

The following three procedures define the syntax of rules:

(define (rule? statement)
(tagged-list? statement 'rule))

(define (conclusion rule) (cadr rule))

(define (rule-body rule)
(if (null? (cddr rule))
'(always-true)
(caddr rule)))

Query-driver-loop (4.4.4.1) calls
query-syntax-process to transform pattern variables in the expression,
which have the form ?symbol, into the internal format (? symbol).
That is to say, a pattern such as (job ?x ?y) is actually represented
internally by the system as (job (? x) (? y)). This increases the
efficiency of query processing, since it means that the system can check to see
if an expression is a pattern variable by checking whether the car of
the expression is the symbol ?, rather than having to extract characters
from the symbol. The syntax transformation is accomplished by the following
procedure:

(define (query-syntax-process exp)
(map-over-symbols expand-question-mark exp))

(define (map-over-symbols proc exp)
(cond ((pair? exp)
(cons (map-over-symbols
proc (car exp))
(map-over-symbols
proc (cdr exp))))
((symbol? exp) (proc exp))
(else exp)))

(define (expand-question-mark symbol)
(let ((chars (symbol->string symbol)))
(if (string=? (substring chars 0 1) "?")
(list '? (string->symbol
(substring
chars
1
(string-length chars))))
symbol)))

Once the variables are transformed in this way, the variables in a pattern are
lists starting with ?, and the constant symbols (which need to be
recognized for data-base indexing, 4.4.4.5) are just the symbols.

(define (var? exp) (tagged-list? exp '?))
(define (constant-symbol? exp) (symbol? exp))

Unique variables are constructed during rule application (in
4.4.4.4) by means of the following procedures. The unique identifier for
a rule application is a number, which is incremented each time a rule is
applied.

(define rule-counter 0)

(define (new-rule-application-id)
(set! rule-counter (+ 1 rule-counter))
rule-counter)

(define (make-new-variable
var rule-application-id)
(cons '? (cons rule-application-id
(cdr var))))

When query-driver-loop instantiates the query to print the answer, it
converts any unbound pattern variables back to the right form for printing,
using

(define (contract-question-mark variable)
(string->symbol
(string-append "?"
(if (number? (cadr variable))
(string-append
(symbol->string (caddr variable))
"-"
(number->string (cadr variable)))
(symbol->string (cadr variable))))))

4.4.4.8Frames and Bindings

Frames are represented as lists of bindings, which are variable-value pairs:

(define (make-binding variable value)
(cons variable value))

(define (binding-variable binding)
(car binding))

(define (binding-value binding)
(cdr binding))

(define (binding-in-frame variable frame)
(assoc variable frame))

(define (extend variable value frame)

(cons (make-binding variable value) frame))

练习 4.70：过程 add-assertion! 和 add-rule! 中 let 绑定的用途是什么？以下 add-assertion! 的实现存在什么问题？提示：回想 3.5.2 中无穷流 ones 的定义：(define ones (cons-stream 1 ones))。

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

4.4.4.6 流操作

查询系统使用了一些第 3 章未曾介绍的流操作。

stream-append-delayed 和 interleave-delayed 与 stream-append 和 interleave（3.5.3）类似，但它们接受一个延迟参数（类似于 3.5.4 中的 integral 过程）。这在某些情形下可以推迟循环的发生（参见练习 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 在整个查询求值器中被用于将一个过程映射到框架流之上，并将所得框架流合并起来；它是 2.2.3 中为普通表引入的 flatmap 过程的流版本。然而，与普通 flatmap 不同，我们采用交错 (interleaving) 方式而非简单拼接来累积各流（参见练习 4.72 和练习 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))))))

求值器还使用以下简单过程来生成仅含单个元素的流：

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

4.4.4.7 查询语法过程

type 和 contents 由 qeval（4.4.4.2）使用，用于指定特殊形式由其 car 中的符号标识。它们与 2.4.2 中的 type-tag 和 contents 过程相同，只是错误消息有所不同。

(define (type exp)
(if (pair? exp)
(car exp)
(error "Unknown expression TYPE"
exp)))

(define (contents exp)
(if (pair? exp)
(cdr exp)
(error "Unknown expression CONTENTS"
exp)))

以下过程由 query-driver-loop（4.4.4.1 中）使用，规定规则和断言通过形如 (assert! ⟨rule-or-assertion⟩) 的表达式添加到数据库中：

(define (assertion-to-be-added? exp)
(eq? (type exp) 'assert!))

(define (add-assertion-body exp)
(car (contents exp)))

以下是 and、or、not 和 lisp-value 特殊形式（4.4.4.2）的语法定义：

(define (empty-conjunction? exps) (null? exps))
(define (first-conjunct exps) (car exps))
(define (rest-conjuncts exps) (cdr exps))
(define (empty-disjunction? exps) (null? exps))
(define (first-disjunct exps) (car exps))
(define (rest-disjuncts exps) (cdr exps))
(define (negated-query exps) (car exps))
(define (predicate exps) (car exps))
(define (args exps) (cdr exps))

以下三个过程定义了规则的语法：

(define (rule? statement)
(tagged-list? statement 'rule))

(define (conclusion rule) (cadr rule))

(define (rule-body rule)
(if (null? (cddr rule))
'(always-true)
(caddr rule)))

query-driver-loop（4.4.4.1）调用 query-syntax-process，将表达式中形如 ?symbol 的模式变量变换为内部格式 (? symbol)。也就是说，诸如 (job ?x ?y) 这样的模式在系统内部实际表示为 (job (? x) (? y))。这提高了查询处理的效率，因为系统只需检查表达式的 car 是否为符号 ?，就能判断该表达式是否为模式变量，而无需从符号中提取字符。语法变换由以下过程完成：

(define (query-syntax-process exp)
(map-over-symbols expand-question-mark exp))

(define (map-over-symbols proc exp)
(cond ((pair? exp)
(cons (map-over-symbols
proc (car exp))
(map-over-symbols
proc (cdr exp))))
((symbol? exp) (proc exp))
(else exp)))

(define (expand-question-mark symbol)
(let ((chars (symbol->string symbol)))
(if (string=? (substring chars 0 1) "?")
(list '? (string->symbol
(substring
chars
1
(string-length chars))))
symbol)))

经过这种变换后，模式中的变量是以 ? 开头的表，而常量符号（需要用于数据库索引的，见 4.4.4.5）则就是普通符号。

(define (var? exp) (tagged-list? exp '?))
(define (constant-symbol? exp) (symbol? exp))

在规则应用时（4.4.4.4 中），通过以下过程构造唯一变量。规则应用的唯一标识符是一个数字，每次应用规则时递增。

(define rule-counter 0)

(define (new-rule-application-id)
(set! rule-counter (+ 1 rule-counter))
rule-counter)

(define (make-new-variable
var rule-application-id)
(cons '? (cons rule-application-id
(cdr var))))

当 query-driver-loop 将查询实例化以打印答案时，它使用以下过程将所有未绑定的模式变量转换回适合打印的形式：

(define (contract-question-mark variable)
(string->symbol
(string-append "?"
(if (number? (cadr variable))
(string-append
(symbol->string (caddr variable))
"-"
(number->string (cadr variable)))
(symbol->string (cadr variable))))))

4.4.4.8 框架与绑定

框架表示为绑定的表，其中每个绑定都是变量-值序对：

(define (make-binding variable value)
(cons variable value))

(define (binding-variable binding)
(car binding))

(define (binding-value binding)
(cdr binding))

(define (binding-in-frame variable frame)
(assoc variable frame))

(define (extend variable value frame)
(cons (make-binding variable value) frame))