网络书屋(Web Reading Room)

A blogging framework for hackers.

The Second Interpreter From One

First Interpreter From EOPL中我们定义了一个最为基本的解释器,包含解释以下解释部分

  1. const-exp
  2. diff-exp
  3. zero?-exp
  4. if-exp
  5. var-exp
  6. let-exp

这六种是比较基础的形式,在此基础上我们可以增加四则运算,加入list操作,加入逻辑比较


1. 增加四则运算

1.1 lang.scm修改四则运算

在the-grammer增加如下expressions

1
2
3
4
  ;;;new add + * /
(expression ("+" "(" expression "," expression ")") add-exp)
(expression ("*" "(" expression "," expression ")") mult-exp)
(expression ("/" "(" expression "," expression ")") div-exp)

1.2 interp.scm修改四则运算

在value-of增加如下expressions

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
       (add-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)))))
       (mult-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)))))
       (div-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)))))

1.3 测试四则运算结果

在原先减法的基础上增加了乘法、加法和除法。

1
2
3
4
5
6
7
8
(run "let x = -(4,1) in +(x,1)")
(run "let x = -(4,1) in *(x,2)")
(run "let x = -(4,1) in /(x,2)")

结果:
    (num-val 4)
    (num-val 6)
    (num-val 1 1/2)

2. 增加逻辑比较

2.1 lang.scm修改逻辑比较

1
2
3
4
5
 ;;增加逻辑比较
    (expression ("equal?" "(" expression "," expression ")") equal?-exp)
    (expression ("less?" "(" expression "," expression ")") less?-exp)
    (expression ("greater?" "(" expression "," expression ")") greater?-exp)
    (expression ("minus" "(" expression ")") minus-exp)

2.2 interp.scm修改逻辑比较

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
       (equal?-exp (exp1 exp2)
                (let ((val1 (value-of exp1 env))
                      (val2 (value-of exp2 env)))
                  (let ((num1 (expval->num val1))
                        (num2 (expval->num val2)))
                    (bool-val
                     (= num1 num2)))))

       (less?-exp (exp1 exp2)
                (let ((val1 (value-of exp1 env))
                      (val2 (value-of exp2 env)))
                  (let ((num1 (expval->num val1))
                        (num2 (expval->num val2)))
                    (bool-val
                     (< num1 num2)))))

       (greater?-exp (exp1 exp2)
                (let ((val1 (value-of exp1 env))
                      (val2 (value-of exp2 env)))
                  (let ((num1 (expval->num val1))
                        (num2 (expval->num val2)))
                    (bool-val
                     (> num1 num2)))))
    (minus-exp (body-exp)
              (let ((val1 (value-of body-exp env)))
                (let ((num (expval->num val1)))
                  (num-val (- 0 num)))))

2.3 测试增加逻辑比较结果

1
2
3
4
5
(run "if less?(1, 2) then 1 else 2")
(run "if greater?(2, 1) then minus(1) else minus(2)")

    (num-val 1)
    (num-val -1)

3. 加入列表操作

3.1 lang.scm修改列表操作

1
2
3
4
5
6
7
;;; 增加list比较
        ;;new stuff
    (expression ("cons" "(" expression "," expression ")") cons-exp)
    (expression ("car" "(" expression ")") car-exp)
    (expression ("cdr" "(" expression ")") cdr-exp)
    (expression ("emptylist") emptylist-exp)
    (expression ("null?" "(" expression ")") null?-exp)

3.2 interp.scm修改列表操作

1
2
3
4
5
6
7
8
9
10
11
12
13
    ;;;增加了list操作
    (emptylist-exp ()
                  (emptylist-val))
    (cons-exp (exp1 exp2)
             (let ((val1 (value-of exp1 env))
                   (val2 (value-of exp2 env)))
               (pair-val val1 val2)))
    (car-exp (body)
            (expval-car (value-of body env)))
    (cdr-exp (body)
            (expval-cdr (value-of body env)))
    (null?-exp (exp)
              (expval-null? (value-of exp env)))

3.3 data-structures.scm增加了expval值类型和4个操作

  • 修改expval部分

增加了pair-valemptylist-val 两个语言的新值,这也是区分之前的四则运算逻辑比较的过程

1
2
3
4
(pair-val
 (car expval?)
 (cdr expval?))
(emptylist-val)
  • 增加了4个expval类型变换操作
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
;;增加4个expval->操作
(define expval->pair
  (lambda (v)
    (cases expval v
     (pair-val (car cdr)
           (cons car cdr))
     (else (expval-extractor-error 'pair v)))))

(define expval-car
  (lambda (v)
    (cases expval v
     (pair-val (car cdr) car)
     (else (expval-extractor-error 'car v)))))

(define expval-cdr
  (lambda (v)
    (cases expval v
     (pair-val (car cdr) cdr)
     (else (expval-extractor-error 'cdr v)))))

(define expval-null?
  (lambda (v)
    (cases expval v
     (emptylist-val () (bool-val #t))
     (else (bool-val #f)))))

3.4 测试修改列表操作结果

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
(run "cons(1, 2)")
(run "car (cons (1, 2))")
(run "cdr (cons (1, 2))")
(run "null? (emptylist)")
(run "null? (cons (1, 2))")

(run "let x = 4
        in cons(x,
          cons(cons(-(x,1),
                    emptylist),
                   emptylist))")

    (pair-val (num-val 1) (num-val 2))
    (num-val 1)
    (num-val 2)
    (bool-val #t)
    (bool-val #f)
    (pair-val (num-val 4) (pair-val (pair-val (num-val 3) (emptylist-val)) (emptylist-val)))

错误的测试:

1
2
3
4
5
6
7
8
9
10
> (run "car (3 5 3)")
. . parsing: at line 1: looking for ")", found number 5 in production
((string "car") (string "(") (non-term expression) (string ")") (reduce #<procedure:car-exp>))
> (run "car (3,5)")
. . parsing: at line 1: looking for ")", found literal-string111 "," in production
((string "car") (string "(") (non-term expression) (string ")") (reduce #<procedure:car-exp>))
> (run "null? ()")
. . parsing: at line 1: nonterminal <expression> can't begin with literal-string111 ")"
> (run "car (cons (3,5))")
(num-val 3)

具体原因是car-exp的定义是通过expval-car的实现,而expval-car接受的是cons创造的数据结构,所以出现了问题。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
  (car-exp (body) (expval-car (value-of body env)))


(pair-val
 (car expval?)
 (cdr expval?))
(emptylist-val)


(define expval-car
  (lambda (v)
    (cases expval v
     (pair-val (car cdr) car)   ;;v在这边是expval类型,更具体来说是pair-val,其他类型没有对应的操作
                                ;;而在当前的情况细 pair-val只能通过cons创建!!
     (else (expval-extractor-error 'car v)))))


并需要增加pair-var?的数据类型

  (define-datatype expval expval?
    (num-val
     (value number?))
    (bool-val
     (boolean boolean?))
    (pair-val
     (car expval?)
     (cdr expval?))
    (emptylist-val))


可以参考value-of中关于cons-exp的定义:
    (cons-exp (exp1 exp2)
             (let ((val1 (value-of exp1 env))
                   (val2 (value-of exp2 env)))
               (pair-val val1 val2)))

注意操作符后面不是必须直接跟上括号(空格会被直接忽略) 而是应该保证括号的对称性。

1
2
3
4
5
6
7
> (run "* (3,4")
. . parsing: at line 1: looking for ")", found end-marker #f in production
((string "*") (string "(") (non-term expression) (string ",") (non-term expression) (string ")") (reduce #<procedure:mult-exp>))
> (run "+(3,4)")
(num-val 7)
> (run "*(3,4)")
(num-val 12)

4.list的具体实现

4.1 lang.scm修改list具体实现

1
    (expression ("list" "(" (separated-list expression ",") ")" ) list-exp)

4.2 interp.scm修改list具体实现

  1. 增加一个apply-elm用于list操作。
1
2
3
4
5
  ;; used as map for the list
(define apply-elm
  (lambda (env)
    (lambda (elem)
      (value-of elem env))))
  1. 增加了list类型
1
2
3
  ;;; 增加了list操作
  (list-exp (args)
           (list-val (map (apply-elm env) args)))

4.3 data-structures.scm修改list的具体实现

增加了list-val的实现:

1
2
3
4
5
6
7
;;;增加了list的具体实现
  (define list-val
  (lambda (args)
    (if (null? args)
  (emptylist-val)
  (pair-val (car args)
        (list-val (cdr args))))))

4.4 测试list具体实现的结果

1
2
3
4
5
6
7
8
(run "list(1, 2, 3)")
(run "car(cdr(list(1, 2, 3)))")
(run "let x = 4
      in list(x, -(x,1), -(x,3))")

    (pair-val (num-val 1) (pair-val (num-val 2) (pair-val (num-val 3) (emptylist-val))))
    (num-val 2)
    (pair-val (num-val 4) (pair-val (num-val 3) (pair-val (num-val 1) (emptylist-val))))

5. cond条件比较

5.1 lang.scm修改cond条件比较

1
2
3
;;增加了cond具体语法
;; new stuff
(expression ("cond" (arbno expression "==>" expression) "end") cond-exp)

5.2 interp.scm修改cond条件比较

  1. 增加一个cond-val,之所以不在类似加入列表实现list具体实现添加val转换,是因为cond-val涉及到value-of 程序,所以需要放在interp.scm中,放在apply-elm之后即可.
1
2
3
4
5
6
7
8
9
10
;;增加了cond-val的处理
;;new stuff
(define cond-val
  (lambda (conds acts env)
    (cond ((null? conds)
     (error 'cond-val "No conditions got into #t"))
    ((expval->bool (value-of (car conds) env))
     (value-of (car acts) env))
    (else
     (cond-val (cdr conds) (cdr acts) env)))))
  1. 在value-of中增加了具体的实现
1
2
3
    ;;;增加了cond操作
         (cond-exp (conds acts)
       (cond-val conds acts env))

5.3 测试cond条件比较结果

1
2
3
4
5
6
7
(run "less?(1, 2)")
(run "cond less?(1, 2) ==> 2 end")
(run "cond less?(2, 1) ==> 1 greater?(2, 2) ==> 2  greater?(3, 2) ==> 3 end")

    (bool-val #t)
    (num-val 2)
    (num-val 3)

6. print显示

6.1 lang.scm修改print显示

1
2
  ;; new stuff
    (expression ("print" "(" expression ")") print-exp)

6.2 interp.scm修改print显示

1
2
3
4
5
6
    ;;;增加了print
    (print-exp (arg)
              (let ((val (value-of arg env)))
                ;(print val)  ;;编译不通过 改为display
                (display val) ;
                (num-val 1)))

6.3 测试print显示结果

1
2
(run "print( less? (1, 2))")
    #(struct:bool-val #t)(num-val 1)

7. let的改进和let*的加入

一个问题

怎么会有问题?

1
2
3
4
5
6
 (run "let x = 30
      in let x = -(x,1)
             y = -(x,2)
         in -(x, y)")
. . parsing: at line 3: looking for "in", found identifier y in production
((string "let") (term identifier) (string "=") (non-term expression) (string "in") (non-term expression) (reduce #<procedure:let-exp>))

分析原先的let设计程序

1
2
3
4
    (let-exp (var exp1 body)
            (let ((val1 (value-of exp1 env)))
              (value-of body
                       (extend-env var val1 env))))

在这个具体实现其实并没有实现多重let的过程,所以导致有问题,所以下一步的关键问题是如何实现嵌套的let-exp解析。

let改进之interp.scm 修改

  1. 增加两个let-exp的辅助程序
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
  ;; let-exp的嵌套实现

  (define value-of-vals
    (lambda (vals env)
      (if (null? vals)
         '()
         (cons (value-of (car vals) env)
              (value-of-vals (cdr vals) env)))))

  (define extend-env-list
    (lambda (vars vals env)
      (if (null? vars)
         env
         (let ((var1 (car vars))
               (val1 (car vals)))
           (extend-env-list (cdr vars) (cdr vals) (extend-env var1 val1 env))))))
  1. 改变letexp的具体实现
1
2
3
4
5
6
7
8
 ;       (let-exp (var exp1 body)       
 ;               (let ((val1 (value-of exp1 env)))
 ;                (value-of body
 ;                          (extend-env var val1 env))))

        (let-exp (vars vals body)
                (let ((_vals (value-of-vals vals env)))
                  (value-of body (extend-env-list vars _vals env))))

7.2 let改进之lang.scm

1
2
3
4
5
6
  ;    (expression
  ;     ("let" identifier "=" expression "in" expression)
  ;     let-exp)
      (expression
        ("let" (arbno identifier "=" expression) "in" expression)
        let-exp)

还是没改好?

1
2
3
4
5
6
link: bad variable linkage;
 reference to a variable that is uninitialized
  reference phase level: 0
  variable module: "/home/canbetter/let-lang/lang.scm"
  variable phase: 0
  reference in module: "/home/canbetter/let-lang/interp.scm" in: a-program?

原因出现在let语法中增加了 (arbno ...)操作。

这个问题可以赘述到cond-exp的实现,其中也涉及到arbno的第一次键入。但是为什么会出现未初始化变量的情况?

但是主要还是因为保存得不彻底!!导致了并未初始化,重新保存即可。

7.3 let改进结果

1
2
3
4
5
6
(run "let x = -(4,1) in let x =+(x,1) in -(x,10)")

    (num-val -6)
(run "let x = -(4,1) in let x =+(x,1)  y=-(x,10) in -(x,y)")

    (num-val 11) ;; x=4 y=-(3,10)=-7  所以-(x,y)=11而不是 10

那么如何实现一个let*,使得let中的x变化的值立即反映到y中。

7.4 let*的lang.scm具体实现

该实现方式基本上和let的语法一样

1
2
  (expression ("let*" (arbno identifier "=" expression) "in" expression) let*-exp)

7.5 let*的interp.scm具体实现

  1. 增加了一个extend-env-list-iter操作,由于也是存在value-of所以放入interp.scm中。
1
2
3
4
5
6
7
8
  (define extend-env-list-iter
    (lambda(vars vals env)
      (if (null? vars)
         env
         (let ((var1 (car vars))
               (val1 (value-of (car vals) env)))
           (extend-env-list-iter (cdr vars) (cdr vals)
                                (extend-env var1 val1 env))))))
  1. let*的类型定义
1
2
        (let*-exp (vars vals body)
                 (value-of body (extend-env-list-iter vars vals env)))

7.6 let*的测试结果

1
2
3
4
5
6
7
8
9
10
11
12
13
(run "let x = 30
      in let x = -(x,1)
             y = -(x,2)
         in -(x, y)")

(run "let x = 30
      in let* x = -(x,1)
             y = -(x,2)
         in -(x, y)")


    (num-val 1)
    (num-val 2)

8. unpack列表赋值

8.1 unpack的interp.scm修改

  1. 增加了extend-env-list-exp的操作,用于针对unpack的特殊的环境拓展,当然可以把它放在data-structures.scm中
1
2
3
4
5
6
7
8
9
10
  ;;; 关于unpack的操作
  (define extend-env-list-exp
    (lambda (vars vals env)
      (if (null? vars)
         env
         (let ((var1 (car vars))
               (val1 (expval-car vals)))
           (extend-env-list-exp (cdr vars)
                               (expval-cdr vals)
                               (extend-env var1 val1 env))))))
  1. unpack-exp的具体实现:
1
2
3
    (unpack-exp (vars vals body)
               (let ((_vals (value-of vals env)))
                 (value-of body (extend-env-list-exp vars _vals env))))

8.2 unpack的lang.scm修改

1
2
;;new stuff
    (expression ("unpack" (arbno identifier) "=" expression "in" expression) unpack-exp)

8.3 测试unpack修改结果

1
2
3
4
5
6
7
;; new testcase
(run "let u = 7
      in unpack x y = cons(u, cons(3,emptylist))
      in -(x,y)")


(num-val 4)  ;;;(x y)= (7 3)  -(7,3)=4

结论

这是这对First Interpreter From EOPL 的8个方面的拓展,对于认识语言的设计有很大的帮助。