First Interpreter from EOPL
这是EOPL一个最为基本的解释器,后面的解释器都在此基础上进行改造,所以 得理解各个部分,并知道如何使用和改造。最终告诉的是解释器如何解释表达式(每一种语言的表达式)。 解释器解释表达式的问题。
- 1. 测试Interpreter程序
- 2. 测试结果
- 3. 反思结果
- 4. 是解决问题,还是抽象问题?科学性何在?
- 5.一个解释器的具体实现
- 5.1 语言前端表现形式 lang
- 5.2 语言数据结构 data-structures
- 5.3 语言中间阶段 environments
- 5.4 语言核心阶段 interpreter
- 5.5 语言的初始化 drscheme-init
- 5.6 语言的测试程序 tests
- 5.7 语言前端封装测试Top
1. 测试Interpreter程序
;;测试一个
(run-tests! run equal-answer?
'(
(positive "11" 11)
))
;;测试二个
(run-tests! run-fn equal-answer?
'(
(positive "11" 11)
(if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
))
2. 测试结果
- one test: positive
test: positive
correct
no bugs found
- two tests:positive if-else
test: positive
correct
test: if-eval-test-true
correct
no bugs found
3. 反思结果
结果测试很理想并没有错误,并且可以在test中不断增加判断语句。 而run-test的解析分为两个部分
- expressions 这部分的工作主要是value-of
- 非expressions 这部分的主要工作就是sligen通过the-grammer的定义进行解析
3.1 非expressions部分
这部分需要配合value-of的define-datatype进行对应的变化,且看the-grammer代码
(define the-grammar
'((program (expression) a-program)
(expression (number) const-exp)
(expression
("-" "(" expression "," expression ")")
diff-exp)
(expression
("zero?" "(" expression ")")
zero?-exp)
(expression
("if" expression "then" expression "else" expression)
if-exp)
(expression (identifier) var-exp)
(expression
("let" identifier "=" expression "in" expression)
let-exp)
))
可以看到if,then,else都被当作不变的地方,而其中三个expressions被传动到value-of做进一步的解析。
3. expressions部分
继续看value-of的部分,则是对if-exp,var-exp,let-exp,letrec-exp,diff-exp,zerp?-exp?等进行解析的过程。
(define value-of
(lambda (exp env)
(cases expression exp
(const-exp (num) (num-val num))
(var-exp (var) (apply-env env var))
(diff-exp (exp1 exp2)
(let ((val1 (value-of exp1 env))
(val2 (value-of exp2 env)))
(let ((num1 (expval->num val1))
(num2 (expval->num val2)))
(num-val
(- num1 num2)))))
(zero?-exp (exp1)
(let ((val1 (value-of exp1 env)))
(let ((num1 (expval->num val1)))
(if (zero? num1)
(bool-val #t)
(bool-val #f)))))
(if-exp (exp1 exp2 exp3)
(let ((val1 (value-of exp1 env)))
(if (expval->bool val1)
(value-of exp2 env)
(value-of exp3 env))))
(let-exp (var exp1 body)
(let ((val1 (value-of exp1 env)))
(value-of body
(extend-env var val1 env))))
)))
可以参考cases的实现,以及cases的作用 当然TLS也提供了比如*const,*application等的定义
;第一大部分 定义好整体框架
(define value
(lambda (e)
(meaning e (quote ()))))
(define meaning
(lambda (e table)
((expression-to-action e) e table))
其中的(expression-to-action)
就会产生对应的*const*,*identifier*,*lambda* ,*cond*,*quote*,*application*
以及TSS中新增加的*set*,*define*,*let*
。
这两个部分是比较有趣的地方,规范了语言的前端部分,犹如左右手交换来交换去和penrose-stair ,进一步可以看看盗墓笔记(inception)的评述
4. 是解决问题,还是抽象问题?科学性何在?
科学进步的每一步发展,不是通过不断抽象来直觉抽取出进步,而是通过直觉发现问题,在利用抽象的方式进行求解,从而获得进步。 而抽象其实就是通过interface和implementation来进行,
- interface的定义就是通过define-datatype进行,
- implementation则是通过cases进行。
4.1 科学性问题何在?
现象和本质的探寻,透过现象看到本质,现象的产生都有其内在的原理,科学关注的是内在的本质联系。 scheme这门语言可以透过不断的抽象,产生许许多多的语言,但是这些语言层是否真的对科学问题有帮助, 这是值得怀疑的地方!科学必须要有怀疑!科学必须找寻问题所在,从而探索产生原因(持保留意见)。
4.2 一个解释器该解决哪些问题?
最基本的我觉得应该有两个:
- 词法解析问题 解决我输入的字符串,该如何由scan&parse进行解析
- 语义解析问题 解决我得到的表达式(expression),它怎么由value-of进行解析,到底是const-exp,var-exp,proc-exp,let-exp等
其实语言系列的表达主要有
- imperative language(C,fortran)
- functional programming language(Lisp,ML,Haskell,Scheme)
- message passing language(OOP: Java,C++,)
他们在解析程序的过程中都离不开上述的两个基本问题的解析,他们也被叫做前端(front-end)。
而任何语言如果仅仅有这个value的过程,而不会产生任何的effects, 比如:
- read
- modify the memory state or file system
那就太没有意思了,所以语言的完成需要他拓充到操作系统的处理、IO处理、显示处理,增加它的趣味性,而不是一味的解决问题(持保留意见)
- 词法解析使我们获得从字符串到对应的语言的const-exp等的exp形式
- 语义解析部分则是我们对const-exp等的具体实现部分
所以本质上来说这两点也是抽象的组成部分(接口和实现),所以本质上解决解释器的实现问题,其实就是如何抽象的问题?。
4.3 抽象的目的是什么?
在于解决现实出现的科学问题。 也就是这些问题都能够被设定的接口和实现通过递归进行解释,并最终获得结果(result or outcome)。
而为什么要绕来绕去的谈这些问题呢? 因为interpreter的实现过程本质也是递归的思想,在不断规约到一个结论。
5. 一个解释器的具体实现
参考EOPL第三章.
一般过程是先思考新语言的表现形式lang.scm,设定几个数据类型放入data-structures.scm中, 然后我们需要给这两个阶段设定bridge,也就是环境封装.这样我们就可以写一个解释器interpreter,解释并获得最终结果。 简而言之,其实我们就是想看看计算机是如何解释我们输入的这句话,具体就是解释器如何解析输入的表达式
- 语言前端表现形式 lang
- 语言数据结构 data-structures
- 语言中间阶段 environments
- 语言核心阶段 interpreter
- 语言的初始化 drscheme-init
- 语言的测试程序 tests
- 语言前端封装测试Top
5.1 前端表现形式
保存为lang.scm
该阶段的主要目的就是定义新生成的语言该是如何使用的?也就是语法部分。
(module lang
;; grammar for the LET language
(lib "eopl.ss" "eopl")
(require "drscheme-init.scm")
(provide (all-defined-out))
;;;;;;;;;;;;;;;; grammatical specification ;;;;;;;;;;;;;;;;
(define the-lexical-spec
'((whitespace (whitespace) skip)
(comment ("%" (arbno (not #\newline))) skip)
(identifier
(letter (arbno (or letter digit "_" "-" "?")))
symbol)
(number (digit (arbno digit)) number)
(number ("-" digit (arbno digit)) number)
))
(define the-grammar
'((program (expression) a-program)
(expression (number) const-exp)
(expression
("-" "(" expression "," expression ")")
diff-exp)
(expression
("zero?" "(" expression ")")
zero?-exp)
(expression
("if" expression "then" expression "else" expression)
if-exp)
(expression (identifier) var-exp)
(expression
("let" identifier "=" expression "in" expression)
let-exp)
))
;;;;;;;;;;;;;;;; sllgen boilerplate ;;;;;;;;;;;;;;;;
(sllgen:make-define-datatypes the-lexical-spec the-grammar)
(define show-the-datatypes
(lambda () (sllgen:list-define-datatypes the-lexical-spec the-grammar)))
(define scan&parse
(sllgen:make-string-parser the-lexical-spec the-grammar))
(define just-scan
(sllgen:make-string-scanner the-lexical-spec the-grammar))
)
5.2 数据结构
保存为data-structures.scm
该阶段的主要目的就是定义对应的类型该具有什么样的接口,这些接口的实现部分在第四部分有具体的体现。 这部分就是程序的类型接口的转换部分。
(module data-structures (lib "eopl.ss" "eopl")
;; data structures for let-lang.
(provide (all-defined-out)) ; too many things to list
;;;;;;;;;;;;;;;; expressed values ;;;;;;;;;;;;;;;;
;;; an expressed value is either a number, a boolean or a procval.
(define-datatype expval expval?
(num-val
(value number?))
(bool-val
(boolean boolean?)))
;;; extractors:
;; expval->num : ExpVal -> Int
;; Page: 70
(define expval->num
(lambda (v)
(cases expval v
(num-val (num) num)
(else (expval-extractor-error 'num v)))))
;; expval->bool : ExpVal -> Bool
;; Page: 70
(define expval->bool
(lambda (v)
(cases expval v
(bool-val (bool) bool)
(else (expval-extractor-error 'bool v)))))
(define expval-extractor-error
(lambda (variant value)
(eopl:error 'expval-extractors "Looking for a ~s, found ~s"
variant value)))
;;;;;;;;;;;;;;;; environment structures ;;;;;;;;;;;;;;;;
;; example of a data type built without define-datatype
(define empty-env-record
(lambda ()
'()))
(define extended-env-record
(lambda (sym val old-env)
(cons (list sym val) old-env)))
(define empty-env-record? null?)
(define environment?
(lambda (x)
(or (empty-env-record? x)
(and (pair? x)
(symbol? (car (car x)))
(expval? (cadr (car x)))
(environment? (cdr x))))))
(define extended-env-record->sym
(lambda (r)
(car (car r))))
(define extended-env-record->val
(lambda (r)
(cadr (car r))))
(define extended-env-record->old-env
(lambda (r)
(cdr r)))
)
5.3 中间阶段
保存为environments.scm
该阶段的主要目的是为了解释当遇到一些变量或者之后的解释器的lambda(将在下一个版本解释器体现),如何保存下来 ,并供对应程序使用。
(module environments (lib "eopl.ss" "eopl")
;; builds environment interface, using data structures defined in
;; data-structures.scm.
(require "data-structures.scm")
(provide init-env empty-env extend-env apply-env)
;;;;;;;;;;;;;;;; initial environment ;;;;;;;;;;;;;;;;
;; init-env : () -> Env
;; usage: (init-env) = [i=1, v=5, x=10]
;; (init-env) builds an environment in which i is bound to the
;; expressed value 1, v is bound to the expressed value 5, and x is
;; bound to the expressed value 10.
;; Page: 69
(define init-env
(lambda ()
(extend-env
'i (num-val 1)
(extend-env
'v (num-val 5)
(extend-env
'x (num-val 10)
(empty-env))))))
;;;;;;;;;;;;;;;; environment constructors and observers ;;;;;;;;;;;;;;;;
(define empty-env
(lambda ()
(empty-env-record)))
(define empty-env?
(lambda (x)
(empty-env-record? x)))
(define extend-env
(lambda (sym val old-env)
(extended-env-record sym val old-env)))
(define apply-env
(lambda (env search-sym)
(if (empty-env? env)
(eopl:error 'apply-env "No binding for ~s" search-sym)
(let ((sym (extended-env-record->sym env))
(val (extended-env-record->val env))
(old-env (extended-env-record->old-env env)))
(if (eqv? search-sym sym)
val
(apply-env old-env search-sym))))))
)
5.4 核心阶段
保存为interp.scm
该阶段的主要目的就是编写针对第3阶段生成的var-exp、const-exp等expval的解析,算是核心部分,最终的结果的产生地, 后面的几个阶段只不过是针对这部分内容做了一些前端的准备,算是死门,而这部分和前面的词法解析、类型转换接口算是一个语言的生门部分。
(module interp (lib "eopl.ss" "eopl")
;; interpreter for the LET language. The \commentboxes are the
;; latex code for inserting the rules into the code in the book.
;; These are too complicated to put here, see the text, sorry.
(require "drscheme-init.scm")
(require "lang.scm")
(require "data-structures.scm")
(require "environments.scm")
(provide value-of-program value-of)
;;;;;;;;;;;;;;;; the interpreter ;;;;;;;;;;;;;;;;
;; value-of-program : Program -> ExpVal
;; Page: 71
(define value-of-program
(lambda (pgm)
(cases program pgm
(a-program (exp1)
(value-of exp1 (init-env))))))
;; value-of : Exp * Env -> ExpVal
;; Page: 71
(define value-of
(lambda (exp env)
(cases expression exp
(const-exp (num) (num-val num))
(var-exp (var) (apply-env env var))
(diff-exp (exp1 exp2)
(let ((val1 (value-of exp1 env))
(val2 (value-of exp2 env)))
(let ((num1 (expval->num val1))
(num2 (expval->num val2)))
(num-val
(- num1 num2)))))
(zero?-exp (exp1)
(let ((val1 (value-of exp1 env)))
(let ((num1 (expval->num val1)))
(if (zero? num1)
(bool-val #t)
(bool-val #f)))))
(if-exp (exp1 exp2 exp3)
(let ((val1 (value-of exp1 env)))
(if (expval->bool val1)
(value-of exp2 env)
(value-of exp3 env))))
(let-exp (var exp1 body)
(let ((val1 (value-of exp1 env)))
(value-of body
(extend-env var val1 env))))
)))
)
5.5 初始化
保存为drscheme-init.scm
该阶段主要目的是编写测试需要的套件,提供测试是否成功的判断标准。
;; drscheme-init.scm - compatibility file for DrScheme
;; usage: (require "drscheme-init.scm")
;;; makes structs printable, and provides basic functionality for
;;; testing. This includes pretty-printing and tracing.
(module drscheme-init mzscheme
;; show the contents of define-datatype values
(print-struct #t)
(require (lib "pretty.ss"))
(provide (all-from (lib "pretty.ss")))
(require (lib "trace.ss"))
(provide (all-from (lib "trace.ss")))
(provide make-parameter)
(provide
run-experiment
run-tests!
stop-after-first-error
run-quietly
)
;; safely apply procedure fn to a list of args.
;; if successful, return (cons #t val)
;; if eopl:error is invoked, returns (cons #f string), where string is the
;; format string generated by eopl:error. If somebody manages to raise a
;; value other than an exception, then the raised value is reported.
(define apply-safely
(lambda (proc args)
(with-handlers ([(lambda (exn) #t) ; catch any error
(lambda (exn) ; evaluate to a failed test result
(cons #f
(if (exn? exn)
(exn-message exn)
exn)))])
(let ([actual (apply proc args)])
(cons #t actual)))))
;; run-experiment :
;; ((a ...) -> b) * (a ...) * b * (b * b -> bool)
;; -> (cons bool b)
;; usage: (run-experiment fn args correct-answer equal-answer?)
;; Applies fn to args. Compares the result to correct-answer.
;; Returns (cons bool b) where bool indicates whether the
;; answer is correct.
(define run-experiment
(lambda (fn args correct-answer equal-answer?)
(let*
((result (apply-safely fn args))
;; ans is either the answer or the args to eopl:error
(error-thrown? (not (car result)))
(ans (cdr result)))
(cons
(if (eqv? correct-answer 'error)
error-thrown?
(equal-answer? ans correct-answer))
ans))))
(define stop-after-first-error (make-parameter #f))
(define run-quietly (make-parameter #t))
;; run-tests! : (arg -> outcome) * (any * any -> bool) * (list-of test)
;; -> unspecified
;; where:
;; test ::= (name arg outcome)
;; outcome ::= ERROR | any
;; usage: (run-tests! run-fn equal-answer? tests)
;; for each item in tests, apply run-fn to the arg. Check to see if
;; the outcome is right, comparing values using equal-answer?.
;; print a log of the tests.
;; at the end, print either "no bugs found" or the list of tests
;; failed.
;; Normally, run-tests! will recover from any error and continue to
;; the end of the test suite. This behavior can be altered by
;; setting (stop-after-first-error #t).
(define (run-tests! run-fn equal-answer? tests)
(let ((tests-failed '()))
(for-each
(lambda (test-item)
(let ((name (car test-item))
(pgm (cadr test-item))
(correct-answer (caddr test-item)))
(printf "test: ~a~%" name)
(let* ((result
(run-experiment
run-fn (list pgm) correct-answer equal-answer?))
(correct? (car result))
(actual-answer (cdr result)))
(if (or
(not correct?)
(not (run-quietly)))
(begin
(printf "~a~%" pgm)
(printf "correct outcome: ~a~%" correct-answer)
(printf "actual outcome: ")
(pretty-display actual-answer)))
(if correct?
(printf "correct~%~%")
(begin
(printf "incorrect~%~%")
;; stop on first error if stop-after-first? is set:
(if (stop-after-first-error)
(error name "incorrect outcome detected"))
(set! tests-failed
(cons name tests-failed)))))))
tests)
(if (null? tests-failed)
(printf "no bugs found~%")
(printf "incorrect answers on tests: ~a~%"
(reverse tests-failed)))))
)
5.6 测试程序
保存为tests.scm
该阶段的主要目的就是编写测试语句,包括常量、变量、表达式、if、diff、let等语句的使用。
(module tests mzscheme
(provide test-list)
;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
(define test-list
'(
;; simple arithmetic
(positive-const "11" 11)
(negative-const "-33" -33)
(simple-arith-1 "-(44,33)" 11)
;; nested arithmetic
(nested-arith-left "-(-(44,33),22)" -11)
(nested-arith-right "-(55, -(22,11))" 44)
;; simple variables
(test-var-1 "x" 10)
(test-var-2 "-(x,1)" 9)
(test-var-3 "-(1,x)" -9)
;; simple unbound variables
(test-unbound-var-1 "foo" error)
(test-unbound-var-2 "-(x,foo)" error)
;; simple conditionals
(if-true "if zero?(0) then 3 else 4" 3)
(if-false "if zero?(1) then 3 else 4" 4)
;; test dynamic typechecking
(no-bool-to-diff-1 "-(zero?(0),1)" error)
(no-bool-to-diff-2 "-(1,zero?(0))" error)
(no-int-to-if "if 1 then 2 else 3" error)
;; make sure that the test and both arms get evaluated
;; properly.
(if-eval-test-true "if zero?(-(11,11)) then 3 else 4" 3)
(if-eval-test-false "if zero?(-(11, 12)) then 3 else 4" 4)
;; and make sure the other arm doesn't get evaluated.
(if-eval-test-true-2 "if zero?(-(11, 11)) then 3 else foo" 3)
(if-eval-test-false-2 "if zero?(-(11,12)) then foo else 4" 4)
;; simple let
(simple-let-1 "let x = 3 in x" 3)
;; make sure the body and rhs get evaluated
(eval-let-body "let x = 3 in -(x,1)" 2)
(eval-let-rhs "let x = -(4,1) in -(x,1)" 2)
;; check nested let and shadowing
(simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
(check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
(check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)
))
)
5.7 前端封装测试
保存为top.scm
该阶段的目的就是测试这个新的解释器语言到底有没有用?他是否能够解释从tests中导入的 程序片段?是否测试通过。
(module top (lib "eopl.ss" "eopl")
;; top level module. Loads all required pieces.
;; Run the test suite with (run-all).
(require "drscheme-init.scm")
(require "data-structures.scm") ; for expval constructors
(require "lang.scm") ; for scan&parse
(require "interp.scm") ; for value-of-program
(require "tests.scm") ; for test-list
;; since this is the top-level module, we don't really need to
;; provide anything, but we do so just in case.
(provide run run-all)
(provide test-all)
(define (test-all) (run-all))
;; here are some other things that could be provided:
;; (provide (all-defined-out))
;; (provide (all-from "interp.scm"))
;; (provide (all-from "lang.scm"))
;;;;;;;;;;;;;;;; interface to test harness ;;;;;;;;;;;;;;;;
;; run : String -> ExpVal
;; Page: 71
(define run
(lambda (string)
(value-of-program (scan&parse string))))
;; run-all : () -> unspecified
;; runs all the tests in test-list, comparing the results with
;; equal-answer?
(define run-all
(lambda ()
(run-tests! run equal-answer? test-list)))
(define equal-answer?
(lambda (ans correct-ans)
(equal? ans (sloppy->expval correct-ans))))
(define sloppy->expval
(lambda (sloppy-val)
(cond
((number? sloppy-val) (num-val sloppy-val))
((boolean? sloppy-val) (bool-val sloppy-val))
(else
(eopl:error 'sloppy->expval
"Can't convert sloppy value to expval: ~s"
sloppy-val)))))
;; run-one : symbol -> expval
;; (run-one sym) runs the test whose name is sym
(define run-one
(lambda (test-name)
(let ((the-test (assoc test-name test-list)))
(cond
((assoc test-name test-list)
=> (lambda (test)
(run (cadr test))))
(else (eopl:error 'run-one "no such test: ~s" test-name))))))
;; (run-all)
)