SICP第四章&&第五章
第四章:元语言抽象
序言:
元语言抽象就是建立新的语言。不仅可以设计新的语言,还可以通过构造求值器的方式实现这些语言。对于求值器,这也是一个过程,在应用这个语言的一个表达式时,能够执行表达式所要求的动作
总的来说:求值器决定了一个程序设计语言中各种表达式的意义,而他本身就是另一个程序。
4.1:元语言求值器
把lisp语言求值器实现为一个lisp程序。可以用这个求值器来求值lisp程序。用与被求值语言同样的语言写出来的求值器称为元循环。
显然,要实现求值器就得要使用描述求值的环境模型。该模型包含两个部分:
- 求值一个组合式(一个不是特殊形式的复合表达式时),首先求值其中的子表达式,然后将运算符子表达式应用于运算对象子表达式的值。
- 将一个复合过程应用于实际参数时,在一个新的环境里求值这个过程的体。构建这一环境的方式是用一个框架扩充过程对象的环境部分,框架中包含的是过程的各个形式参数与这一过程应用的各个实际参数。
这两条规则是求值的核心。也是一种循环。在这一种循环中,表达式在环境中的求值被归约到过程对实际参数的应用,这种应用又被归约到新环境中的求值。这种循环实际体现为apply与eval的相互作用。
eval是一个过程,它的参数是一个表达式和一个环境。eval对表达式进行分类,引导求值工作。eval其实可以看做是一种分情况分析。这样我们就需要考虑到表达式的类型和判定的工作。书中将表达式分为以下几种类型:
- 基本表达式:自值(数字),返回本身。
- 引用,返回被引的表达式。
- 变量的赋值:递归调用Eval计算出需要关联这个变量的新值,修改环境,改变这个变量的约束。
- if表达式
- lambda表达式,转换为一个可以应用的过程,方法是将这个lambda表达式的参数表与体与求值环境包装起来。
- begin表达式,按照顺序求值其中的一系列表达式
- cond变换为一组嵌套的iF表达式
如果不是上述类型,就是组合式。Eval递归求值组合式的运算符部分和运算对象部分,将得到的过程和参数送给apply,让它去处理实际的过程应用
以下是eval的定义
(define (eval exp env) (cond ((self-evaluating? exp) exp);;如果是自表达式,返回本身 ((variable? exp) (lookup-variable-value exp env));;如果是变量,在环境中查找并返回 ((quoted? exp) (text-of-quotation exp));;如果是引用表达式,去掉引用标志后返回 ((assignment? exp) (eval-assignment exp env));;如果是赋值,计算出新值,并在环境中建立约束 ((definition? exp) (eval-definition exp env));;如果是定义,和赋值差不多 ((if? exp) (eval-if exp env));;如果是if表达式,求值if表达式 ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env));;如果是lambda表达式,返回过程 ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval (cond->if exp) env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env)));;如果是组合式递归求值组合式的运算符部分和运算对象部分,将得到的过程和参数送给apply,让它去处理实际的过程应用 (else (error "Not defined to handle exp -- EVAL" exp))))
未注释部分一般不是核心内容很多是语法糖或派生表达式。可以不考虑。实际上,为了方便以后加入一些新的类型,可以把eval实现为数据导向,按照类型分派。即维护一个表,有新的类型就“加入”,需要就“取出”。
接下来是apply。它有两个参数,一个是过程,一个是过程实际应用的实际参数的表。apply将过程分成两类,如果是基本过程,就直接应用基本过程。如果是复合过程,就书序求值组成这个过程体的表达式。求值复合环境时要建立相应的环境。这个环境的构造方式是通过扩充过程所在的环境得到,并加入一个框架,在其中将各个形式参数约束到实际参数
以下是apply的定义:
(define (apply procedure arguments env)
(cond ((primitive-procedure? procedure);;应用基本过程
(apply-primitive-procedure procedure
(list-of-arg-values arguments env)))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure) ;形参
(list-of-delayed-args arguments env) ;实参
(procedure-environment procedure)))) ;父环境
(else (error "Unknown procedure type -- APPLY" procedure))))
这两个部分就是求值器的核心组件。如果需要它能够实际运行,还需要完善和定义被求值表达式的语法形式。这里采用了数据抽象技术,使求值器独立于语言的具体表示。
接下来给出部分表达式的表示,和上面的部分组件的定义,但不多,只是参考一下是如何表示的
(define (eval-if exp env);;如何求值if表达式
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
(define (eval-sequence exps env);;求值一个表达式序列
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
(define (eval-assignment exp env);;求值一个赋值
(set-variable-value! (assignment-variable exp)
(eval (assignment-value exp) env) env) 'ok)
(define (eval-definition exp env);;求值一个定义,和赋值差不多
(define-variable! (definition-variable exp)
(eval (definition-value exp) env) env) 'ok)
;;书中把所有表达式都表示为标志-内容的序对,可通过查看标志来判断类型
(define (self-evaluating? exp) ;;数字或者字符串
(cond ((number? exp) #t) ((string? exp) #t) (else #f)))
(define (variable? exp) (symbol? exp));;是不是变量
(define (quoted? exp) (tagged-list? exp 'quote)) ;引用表达式
(define (text-of-quotation exp) (cadr exp));引用的内容
(define (tagged-list? exp tag) (if (pair? exp)
(eq? (car exp) tag)
#f));;查看标志
(define (assignment? exp) (tagged-list? exp 'set!)) ;赋值判断
(define (assignment-variable exp) (cadr exp)) ;取出变量名
(define (assignment-value exp) (caddr exp)) ;取出变量值
(define (definition? exp) (tagged-list? exp 'define));;定义判断
(define (definition-value exp);;取出定义值
(if (symbol? (cadr exp)) (caddr exp) ;<value>
(make-lambda (cdadr exp) (cddr exp)))) ;<pa>.. <body>..
(define (lambda? exp) (tagged-list? exp 'lambda)) ;lambda表达式判断
(define (lambda-parameters exp) (cadr exp)) ;;取出过程参数
(define (lambda-body exp) (cddr exp)) ;取出过程体
(define (make-lambda parameters body) (cons 'lambda (cons parameters body)))
(define (if? exp) (tagged-list? exp 'if)) ;(if (<pre>) <a> <b> )
(define (if-predicate exp) (cadr exp));;取出判断谓词
(define (if-consequent exp) (caddr exp));;为真则执行这个语句
(define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) '#f));;为假执行这个
(define (make-if pre conse alt) (list 'if pre conse alt))
(define (begin? exp) (tagged-list? exp 'begin)) ;(begin (xxx) (yyy))
(define (begin-actions exp) (cdr exp))
(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (make-begin seq) (cons 'begin seq))
(define (sequence->exp seq) ;实现一些表达式的转换
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (application? exp) (pair? exp)) ;(operator operands...)
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operands ops) (cdr ops))
(define (cond? exp) (tagged-list? exp 'cond)) ;(cond (???))
(define (cond-clauses exp) (cdr exp)) ;(pred action..): (a b) or (else g)
(define (cond-else-clause? clause) (eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond-spec-form? clause) (eq? (cadr clause) '=>)) ;(<pre> => <act>)
(define (cond-spec-form-actions clause) (caddr clause)) ;<act>
(define (cond->if exp)
(define (expand-clauses clauses)
(if (null? clauses) '#f
(let ((first (car clauses)) (rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "else clause isn't last -- COND->IF" clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))
(expand-clauses (cond-clauses exp)))
(define (let? exp) (tagged-list? exp 'let))
;(let ((a 2) (b 3)) x y) -> ((lambda (a b) x y) 2 3)
(define (let->lambda exp)
(let ((var-pairs (cadr exp)) (body-exps (cddr exp)))
(cons (make-lambda (map car var-pairs) body-exps)
(map cadr var-pairs))))
;(let name ((a 2) (b 3)) x y (name a b)) ->
;((lambda () (define (name a b) x y (name a b)) (name 2 3)))
(define (make-define-lambda name vars body calls)
(list (list 'lambda '()
(cons 'define (cons (cons name vars) body))
(cons name calls))))
后面部分不再注释,实际上都是一些构造函数,选择函数,表达式的转换之类的。
通过一些基本表达式,还可以构造一些派生的表达式。比如cond实际上也可以看做if的一种语法糖。自然也可以把cond转换为if表达式。上面有例子。
当然还有环境和框架等的实现。环境可以表示为框架的表。每个框架又是一对表形成的序对。一个是变量名表,另一个是约束值表。以下提供部分定义
(define (make-frame var val) (cons 'frame (map cons var val)))
(define (add-binding-to-frame! var val frame)
(set-cdr! frame (cons (cons var val) (cdr frame))))
(define (set-var-to-frame! var val frame)
(let ((find #f))
(set-cdr! frame
(map (lambda (pair)
(if (eq? (car pair) var)
(begin (set! find #t) (cons var val))
pair))
(cdr frame)))
find))
(define (set-variable-value! var val env)
(define (env-loop env)
(if (eq? env the-empty-environment)
(error "Unbound variable -- SET!" var)
(if (set-var-to-frame! (first-frame frame)) 'done
(env-loop (enclosing-environment env)))))
(env-loop env))
(define (define-variable! var val env)
(let ((frame (first-frame env)))
(if (set-var-to-frame! var val frame) 'done
(add-binding-to-frame! var val frame))))
这些具体实现并不是本章的核心内容。本章的核心仍然在于eval和apply的定义。只是提供出来作为例子用作参考。
在思考这个求值器时,我们可以把程序看做一个机器的描述、而我们的求值器可以看做一种通用机器,它能够模拟其他的任何用lisp语言编写的程序(机器)。比如我们可以在lisp语言环境中编写一个C语言求值器,那么我们就能够模拟任何C语言程序。从这方面我们可以看出求值器所具有的的巨大威力。另外还有一点,它构造了数据对象与程序设计语言本身的桥梁,一个(* x x),从求值器看,其实就是一个表,但在我们看来,则实现了平方。
书中接下来还给出了一些在我看来是拓展内容的部分,不是核心,以下简单阐述:
- 内部定义:在一个过程中定义两个内部过程。最符合直觉的情况,其实是认为两个内部过程都被同时加入环境中。或者说,在块结构中,一个局部名字的作用域应该是其求值所在的整个过程体。为实现这个功能,可以在求值lambda表达式之前,扫描并删除掉过程体中的所有内部定义,并用let常见内部定义的变量,通过赋值设置它们的值。
- 记忆性语法分析(分析与执行的分离):如果一个表达式要执行许多次,那么对它进行的语法分析就要执行很多次。比如一些递归的过程(求斐波那契数列等)。这是很低效的。为解决这个问题。可以把eval分割成两个部分。过程analyze只取表达式作为参数,执行语法分析,返回一个新的过程。过程称为执行过程,其中封装起在分析表达式的过程中已经完成的工作。这个执行过程以一个环境为参数,完成实际的求值工作。这样子,对一个表达式求值只需要调用一次analyze,而执行过程可以调用多次。
惰性求值:这部分内容较多。Scheme采用的是应用序语言。在过程应用时,过程的所有参数都要求值(这称作过程对参数严格)。还有另外一种正则序,把对过程参数的求值延后到实际需要这些参数的时候(过程对参数非严格)。
显然在使用if或者cond的时候我们会希望这个过程是非严格的,以便让我们的程序能够继续运行下去。为此,我
们需要引入惰性求值(其中的复合过程对任何参数都是非严格的,基本过程仍然是严格的)。这里的原则是,对于 application? 谓词的判断,操作符直接求值,参数如果是复杂过程的话延迟求值,基本过程则直接返回值。
这里引入一种数据结构--槽。对于需要延时求值的表达式,把它变换为槽。槽中包含着产生值的所有信息(即参数表达式)和对这一过程应用的求值所在的那个环境
对槽中的表达式求值的过程称为强迫(force)
;;eval和apply需要作出一定的修改
((application? exp)
(apply (actual-value (operator exp) env);;修改,需要强迫求值
(operands exp) env))
(define (apply procedure arguments env)
(cond ((primitive-procedure? procedure)
(apply-primitive-procedure procedure
(list-of-arg-values arguments env)))
((compound-procedure? procedure)
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure) ;形参
(list-of-delayed-args arguments env) ;实参
(procedure-environment procedure)))) ;父环境
(else (error "Unknown procedure type -- APPLY" procedure))))
;;提供一些槽相关的表示
(define (actual-value exp env) (force-it (eval exp env)))
(define (list-of-arg-values exps env)
(if (no-operands? exps) '()
(cons (actual-value (first-operand exps) env)
(list-of-arg-values (rest-operands exps) env))))
(define (list-of-delayed-args exps env)
(if (no-operands? exps) '()
(cons (delay-it (first-operand exps) env)
(list-of-delayed-args (rest-operands exps) env))))
; (define (force-it obj)
; (if (thunk? obj)
; (actual-value (thunk-exp obj) (thunk-env obj))
; obj))
(define (delay-it exp env) (list 'thunk exp env))
(define (thunk? obj) (tagged-list? obj 'thunk))
(define (thunk-exp thunk) (cadr thunk))
(define (thunk-env thunk) (caddr thunk))
(define (actual-value exp env) (force-it (eval exp env)))
(define (evaluated-thunk? obj)
(tagged-list? obj 'evaluated-thunk))
(define (thunk-value evaluated-thunk) (cadr evaluated-thunk))
(define (force-it obj)
(cond ((thunk? obj)
(let ((result (actual-value (thunk-exp obj) (thunk-env obj))))
(set-car! obj 'evaluated-thunk)
(set-car! (cdr obj) result)
(set-cdr! (cdr obj) '())
result))
((evaluated-thunk? obj)
(thunk-value obj))
(else obj)))
;;不仅如此求值器中很多地方都需要修改,这里不提供
如果使用这种惰性求值器,流就可以很自然地看做是惰性的表。甚至其惰性更强,因为其car部分也是惰性的。
可以不引入新表达式,而把cons表示为一种过程。
(define (cons x y) (lambda (m) (m x y)))
(define (car z) (z (lambda (p q) p)))
(define (cdr z) (z (lambda (p q) q)));;不知道这是如何构造的,但使用代换模型代换会发现确实是可以运行的
4、非确定性计算:计算机程序提供的往往是解决问题的方法。但我们也希望能够只要描述好一个问题,就能得到解。这里的关键想法在于,表达式可以有多于一个的可能值。非确定性发求值器从表达式中选出一个可能的值,维持其有关的轨迹。如果随后的要求不满足,求值器就尝试另一种选择。不断作出选择直到求值成功或用光所有选择。这可以看做是把自动搜索功能或者是回溯算法内嵌入求值器中。
为此需要引入一个新的结构--amb。表达式amb可以返回m个子表达式之一的值
;;以下提供部分相关的操作
(define (require p)
(if (not p) (amb)))
;;这个require对一个条件进行判断,如果不满足则返回 (amb) 表示没有可用解。换言之,我们的解释器现在维护了一个深度优先结构,其包含一个可用值,require 进行谓词检测,如果不满足条件则调用 (amb),这个表达式在解释器中会告知一次执行失败和回滚以产生下一个可用值,直到满足或者没有可用结果为止。
(define (an-element-of items)
(require (not (null? items)))
(amb (car items) (an-element-of (cdr items))))
(define (an-integer-starting-from n)
(amb n (an-integer-starting-from (+ n 1))))
(define (prime-sum-pair list1 list2)
(let ((a (an-element-of list1))
(b (an-element-of list2)))
(require (prime? (+ a b)))
(list a b)))
;(prime-sum-pair '(1 3 5 8) '(20 35 110))
;amb是这样的一种数据结构,他需要包括表达式执行成功时的回调和失败时的回调。其中成功回调包含两个参数,当前值和失败回调,这里的实例简单的为成功回调打印值,失败回调返回 'failed。这里不提供具体实现
4.4、逻辑程序设计
计算机科学处理命令式(怎么做)的知识,而数学则用于说明式(是什么)的知识,这一观点从第一章开始到现在为止大部分情况下都是成立的。但尽管大部分程序设计语言倾向于单一方向(清晰的输入和输出)的计算,我们也不能说“计算机程序 = 数据结构(数据抽象) + 算法(过程抽象)”代表了程序的全部,之前介绍的约束系统、上面介绍的非确定性求值器(包括数据查询语言 SQL)都不属于此类。本节将要实现一门数据查询语言,尽管 LISP 并不是实现这一目标的最佳方式,但是 LISP 提供的基本元素、基于基本元素的组合、抽象能力非常简洁和灵活,能让我们迅速打造出能表述及其复杂关系的查询语句,并使我们定义查询语言的表达能力更加强大。
这门语言用于数据库查询,其一般性框架是:
基本元素:简单查询
复合元素;复合查询,引入 了and、or 和 not
抽象方法:规则。rule 形式用于给定一条具名规则,其可以包含复合查询和简单查询
查询系统工作原理
因为查询系统是一个非确定性的程序,考虑基于流来实现查询。查询系统的组织结构围绕两个核心操作。分别称为模式匹配和合一。复合查询需要用到流。
复合查询可以这么理解,and是先进行一次查询,得到扩充的框架之后,把框架送到第二次查询,再次扩充,依次这么做下去直到遍历完所有查询。or是把输入流再复制一份,分别送入查询中,得到的两组扩充框架做合并就得到了输出流。not从输入流中删除所有满足查询的框架。
首先介绍查询系统最为核心的两个部分。
模式匹配是一个程序,它检查数据项是否符合一个给定的模式。模式匹配器以一个模式,一个数据和一个框架作为输入。框架描述了一些模式变量的约束。模式匹配器检查该数据是否以某种方式与模式匹配,同时这种匹配与框架中已有的约束相容。如果确实如此,返回一个扩充的框架,加入了在这次匹配中确定的所有新约束。
合一是一个程序,它取两个模式作为参数,尝试这两个模式能否合并成一个,如果能找到,就返回包含有关约束的框架。
在查询器里完成一个匹配是这样做的:
- 将这个查询与规则做的结论合一,以便形成原来框架的一个扩充。
- 相对于扩充后的框架,求值由规则体形成的查询。
;核心过程,传入框架流,对 query 进行匹配,返回被 query 扩充过的框架流
(define (qeval query frame-stream)
;这里首先查找根据查找的 car 尝试进行分派(and, or, not 等)
;如果有分派,则使用分派过程来处理: conjoin, disjoin, negate
;如果没有分派,则调用 simple-query 进行处理:简单查询 or rule 合一
(let ((qproc (get (type query) 'qeval)))
(if qproc
;qproc 过程的执行参见下文 conjoin, disjoin, negate, lisp-value
(qproc (contents query) frame-stream)
;不论是分派无法找到的还是分派找到的,最终都会进入到这里(分派
;是对简单查询的组合,其本质还是要为每个简单查询调用 qeval)
;因此这里的 simple-query 才是查询器的核心过程
(simple-query query frame-stream))))
;数据导向分派支持 and 查询
(define (conjoin conjuncts frame-stream)
;递归对 and 查询的每个子查询调用 qeval,返回最终框架
;(and q1 q2) -> (qeval q2 (qeval q1 f-init))
(define (empty-conjunction? exps) (null? exps))
(define (first-conjunct exps) (car exps))
(define (rest-conjuncts exps) (cdr exps))
(if (empty-conjunction? conjuncts)
frame-stream
(conjoin (rest-conjuncts conjuncts)
(qeval (first-conjunct conjuncts)
frame-stream))))
;数据导向分派支持 or 查询
(define (disjoin disjuncts frame)
;对 or 查询的每个子查询调用 qeval,最后合并为新的流框架
;这里的合并不使用 stream-append 而是 interleave-delayed
;以便于每个子查询能轮流输出
(define (empty-disjunction? exps) (null? exps))
(define (first-disjunct exps) (car exps))
(define (rest-disjuncts exps) (cdr exps))
(if (empty-disjunction? disjuncts)
the-empty-stream
(interleave-delayed
(qeval (first-disjunct disjuncts) frame-stream)
(delay (disjoin (rest-disjuncts disjuncts)
frame-stream)))))
;数据导向分派支持 not 查询
(define (negate operands frame-stream)
;对框架流的每个框架检查,如果当前 query qeval 为空,则重新包含反之则置为空
(define (negated-query operands) (cadr operands))
(stream-flatmap
(lambda (frame)
(if (stream-null? (qeval (negated-query operands)
(singleton-stream frame)))
(singleton-stream frame)
the-empty-stream))
frame-stream))
;数据导向分派的一种特例,对于任何输入,始终返回框架
(define (always-true ignore frame-stream) frame-stream)
(put 'and 'qeval conjoin)
(put 'or 'qeval disjoin)
(put 'not 'qeval negate)
(put 'lisp-value 'qeval lisp-value)
(put 'always-true 'qeval always-true)
simple-query 是查询过程的核心,其使用 find-assertions 查找断言并扩充框架,最后实例化并打印。如果无法找到断言,则可能是规则,因此通过 apply-rules 查找规则并进行合一过程,再交给 qeval 进行 rule 体的复合表达式的绑定。为了体现层次结构,这里使用了局部过程,相关注解非常详细,注意要考虑的多种细节(比如合一的 depends-on?),以及这种复杂性如何通过递归优雅的实现(比如 pattern-match)。
;上述的入口和可扩展机制类似于 eval,而这里的 simple-query 则类似于 apply
;(包括基本过程的处理和复杂过程的处理 - 对应这里的 pattern-match 和 unify-match)
;对于框架流的每个框架进行查询匹配(find-assertions),返回扩充过的框架流(apply-rules)
(define (simple-query query-pattern frame-stream)
(define (find-assertions pattern frame)
;核心 API 的核心过程,用于对断言和查询进行 frame 下的匹配
(define (pattern-match pat dat frame)
;查找当前变量在框架中是否有绑定,如果没有则 extend 扩充当前框架
;如果有,则将当前变量替换为其值并继续尝试(不直接失败的原因是可能这个
;值也是一个变量或者包含变量的序对,比如 ?x -> (3 ?y)
(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))))
;配合 (and (pair? pat) (pair? dat))
(cond ((eq? frame 'failed) 'failed)
;匹配到一个完全一致断言,直接返回此框架,无需扩充
((equal? pat dat) frame)
;遇到变量,则调用 extend-if-consistent 对当前变量进行扩充
((var? pat) (extend-if-consistent pat dat frame))
;如果当前元素是序对,递归进行处理(即先处理头部元素,试图将其作为扩充后的框架)
;如果失败,在 cond 头部即可匹配到,直接失败
((and (pair? pat) (pair? dat))
(pattern-match (cdr pat)
(cdr dat) (pattern-match (car pat) (car dat) frame)))
(else 'failed))) ;其他情况,直接失败
;使用 pattern-match 对数据库传入断言 assertion 和查询模式 query-pat 在 query-frame 下
;进行检查,如果满足要求,则返回扩充过的流,反之返回空流
(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))))
;fetch-assertions 查找 pattern car 匹配的所有断言,然后针对每一条断言
;执行 check-an-assertion 进行检查
(stream-flatmap (lambda (datum)
(check-an-assertion datum pattern frame))
(fetch-assertions pattern frame)))
;如果简单查询失败(为空)则可能意味着是一个规则,需要进行合一
(define (apply-rules pattern frame)
(define (unify-match p1 p2 frame)
;和 extend-if-consistent 类似,这里先通过 binding-in-frame 查找当前变量
;是否存在绑定,如果有,那么递归进行 unify-match 去处理(扩展 or 继续绑定)
;在递归得到扩展之前(走到 extend 分支)还需要进行两种检查:
;①如果待匹配目标 val 也是变量,那么就在框架查找它是否有约束的值
;如果有,则使 var 约束到这个绑定而非变量 val,如果没有,则使 var 绑定到 val。
;②如果待匹配目标 val 和 var 之间互相依赖(depends-on?),那么直接失败。
(define (extend-if-possible var val frame)
;递归查找当前待匹配目标 val 是否和 var 互相依赖
(define (depends-on? exp var frame)
(define (tree-walk e)
(cond ((var? e)
(if (equal? var e) #t ;val 和 var 完全一致,直接返回
;从框架查找 val 变量绑定,如果找不到,则意味着没有依赖
;如果找到,那么递归为找到的值查找依赖
(let ((b (binding-in-frame e frame)))
(if b (tree-walk (binding-value b)) #f))))
((pair? e) ;如果是序对,则对每个元素分别进行依赖查找
(or (tree-walk (car e))
(tree-walk (cdr e))))
(else #f)))
(tree-walk exp))
(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))))
;不允许 (?x ?x) -> (?y <xx ?y>)
((depends-on? val var frame) 'failed)
(else (extend var val frame)))))
;类似于 pattern-match 过程,不过遇到变量进入 extend-if-possible继续检查
(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)))
;对规则 rule,首先要将其整体变量重命名(避免和 query 冲突),然后
;调用 unify-match 对 rule 的头进行匹配得到扩充过的框架流,
;此过程失败,则返回空流
;成功则将 rule 的体(复合query)用扩充过的框架流 qeval 继续进行匹配。
(define (apply-a-rule rule query-pattern query-frame)
(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)))
(let ((clean-rule (rename-variables-in rule)))
(let ((unify-result
(unify-match query-pattern
(conclusion clean-rule)
query-frame)))
(if (eq? unify-result 'failed)
this-empty-stream
(qeval (rule-body clean-rule)
(singleton-stream unify-result))))))
;合一和应用模式匹配类似,先通过 fetch-rules 找到所有 rules
;(包括 car pattern 开头的和 ? 开头的),然后对每条规则进行
;apply-a-rule
(stream-flatmap (lambda (rule)
(apply-a-rule rule pattern frame))
(fetch-rules pattern frame)))
;对传入的框架流每一个框架分别执行如下两个过程,生成两个流并合并:
;查找数据库中复合 query 查询模式的断言
;如果找不到断言,则可能是一条 rule,需要进行合一过程(这里才是过程执行,上面都是内部定义)
(stream-flatmap
(lambda (frame)
(stream-append-delayed
(find-assertions query-pattern frame)
(delay (apply-rules query-pattern frame))))
frame-stream))
这里只实现最核心的部分,其他的比如数据库的维护,查询的语法,驱动循环,流的一些操作,约束的实现等都不给出。掌握意思即可。
这个查询系统还有很多问题,比如说查询的效率慢,还有查询时需要给变量换名,还有一个本质性的困难问题:查询里的not与逻辑运算里的not不是一个意思。查询里的not表示无法推断出,而逻辑运算里的not是非真,假。这是一个微妙但很重要的区别。
这个查询一同也让我想到了mysql和正则匹配。它们之间很可能有些关系。
第五章、寄存器机器里的计算
5.1、寄存器的设计
寄存器机器包括两个部分:数据通路(寄存器和操作)和控制器。寄存器中保存着值,可读可写。操作是程序支持的操作,控制器是操作的指令序列。
主要有以下的操作:
- assign赋值,给寄存器一个新值。其能力还可以扩展。可以给寄存器将控制器序列里的标号作为值
- test,执行相应的检测
- branch有条件地转到某个位置的分支指令,往往与检测指令一起使用
- goto,无条件跳转,跳转到指明的控制器标号。可拓展,用一个寄存器的名作为参数,跳转到寄存器保存的序列标号。
- save,压栈
restore,弹栈
书中给出了一些灵活的用法:一是通过巧妙的安排,可以让子程序(相同机器产生出来的不同实例共享其中的某些组件)。还有一个就是通过堆栈来实现递归,形成一种“无穷”的假象(这是实现递归必须的)。
具体看一看书上实现的斐波那契数列(使用双重递归)。
个人感觉到寄存器这种层面的话似乎迭代会更好理解。递归看着有些奇怪。毕竟硬件层面是顺序地执行指令序列的。
5.2、一个寄存器 机器模拟器
了解即可。用程序模拟一个寄存器机器。
把一个寄存器表示为带有局部状态的过程。结合消息传递调用不同的功能(读和写)。
堆栈表示为一个带有局部状态的过程。局部状态是一个包含着这一个堆栈里的数据项的表。通过消息传递调用push,pop,initialize(初始化)。
一个寄存器模拟器是一个这样的对象,内部状态包括一个堆栈,一个初始为空的指令序列(控制器),和一个操作的表,还有一个寄存器的表。
接着再具体实现寄存器的各种操作,指令序列。
以上为大体思路。
5.3、存储分配和废料收集
实际的计算机存储器是有穷的。为此我们需要提供一种自动存储分配的功能。当一个数据对象不再需要时,可以自动回收这个数据对象的内存。
常用计算机的存储器的存储空间是线性排列的,可看做一串排列整齐的小隔间。每个小隔间可以保存一点信息,每个小隔间有唯一的地址。存储器系统提供两个基本操作,取出特定位置的元素和把新的元素赋给指定的位置。
再映入一个模拟存储空间的数据结构:向量,或者说数组,就可以实现基本的表操作(cons等),堆栈。
以上是存储分配。接下来介绍废料收集。
废料收集基于以下认识:在解释过程中的任意时刻,有可能影响未来的计算过程的对象,也就是从当前机器寄存器里的指针出发,经过car和cdr操作能够达到的对象。其他对象就都是废料,可以被回收。
书中介绍了一个方法:停止并复制。把存储器分为两半,工作存储区和自由存储区。当构造序对时,在工作存储区分配它们,工作存储区满时执行废料收集,确定所有位于工作存储区里的有用序对的位置,把它们赋值到自由存储区的连续位置上。再交互工作存储区与自由存储区的名,在新的工作存储区,也就是原来的自由存储区里分配序对。如果又满了,重复上述操作。
5.4、显式控制的求值器
即把元循环求值器程序变换为寄存器机器。求值器寄存器机器包含一个堆栈和七个寄存器。exp用来保存被求值的表达式。env用来保存这一个求值进行时所在的环境。求值结束时,用val保存得到的结果。continue保存的是求值结束后跳转到的位置。(用来实现递归)。proc,argl,unev用在求值组合式的时候。proc保存过程体,argl用来保存实际参数,形成实际参数表。unev用来保存尚未求值的参数。具体实现看书。
如果一个求值器在执行迭代过程时,采用的方法能够在该过程继续调用自身时不需要增加存储(不把信息push入栈中),就称作尾递归求值器。
5.5、编译
显式控制求值器是采用的解释的策略,即它是一种解释器。解释是用有关机器的本机语言写出一个解释器。解释器配置好这台机器,使得它能够执行某个语言(源语言)的程序。源语言的基本过程被实现为一个子程序库。用给定机器的本机语言写出。被解释程序(源程序)用一个数据结构表示(求值器用的是表)。解释器遍历这种结构,分析源程序,模拟源程序的行为。
另外还有一种被称为编译的策略。编译器是把源程序翻译成这部机器的本机语言写出来的等价程序。(目标程序)
编译执行效率高,而解释为程序开发和Debug提供更强大的环境。
解释器和编译器很像。它们用同样的方式去遍历表达式。不过解释器在求值表达式时,当要执行一条寄存器指令时,会执行这条指令,而编译器在这是则会把它收集到一个指令序列里,得到的指令序列就是目标代码(目标程序)。
具体实现看书。
## 至此SICP学习完毕!完结撒花!