[Scheme]一个Scheme的Metacircular evaluator

这个解释器可以用来跑前面两篇文章的例子，所以一并扔出来，三部曲哈哈。

 

Lisp内置的S-expression相当于解析好的语法树，而借助quasiquote和unquote又很容易进行语法树层面的变换，所以Lisp的自举和扩展都很容易。

相对而言，其他语言有入门教材就讲怎么实现语言自身的解释器的吗？至少命令式语言恐怕不容易，尤其是中缀表示法的语言，Parser这一关会卡死很多人。

 

这个解释器的典型特性包括currying、call/cc，所以可以用来跑前面的lambda calculus和yin-yang-puzzle例子：

 1 #lang racket
 2 
 3 (require racket/match)
 4 ;------------------------------
 5 (define (eval env e k)
 6   (match e
 7          [(? symbol?) (k (cdr (assq e env)))]
 8          [(list 'lambda arg-list exp-list ...)
 9           (let ([arg-list (if (empty? arg-list) '(_) arg-list)])
10             (cond
11               [(> (length arg-list) 1) 
12                (eval env `(lambda (,(car arg-list)) (lambda ,(cdr arg-list) ,@exp-list)) k)]
13               [(> (length exp-list) 1) 
14                (eval env `(lambda ,arg-list ((lambda (_) ,@(cdr exp-list)) ,(car exp-list))) k)]
15               [else (k 
16                       (lambda (arg k2) 
17                         (eval (cons (cons (car arg-list) arg) env) (car exp-list) k2)))]))]
18          [(list p arg-list ...)
19           (let ([arg-list (if (empty? arg-list) '(print) arg-list)])
20             (if (= 1 (length arg-list))
21               (eval env p (lambda (p) 
22                             (eval env (car arg-list) (lambda (arg)
23                                                        (p arg k)))))
24               (eval env `((,p ,(car arg-list)) ,@(cdr arg-list)) k)))]
25          )
26   )
27 ;------------------------------
28 (define G (list 
29             (cons 'print (lambda (n k) 
30                            (n (lambda (v k2)
31                                 (k2 (add1 v))) 
32                               (lambda (v) 
33                                 (v 0 (lambda (v) (k (print v))))))))
34             (cons 'newline (lambda (_ k)
35                              (k (newline))))
36             (cons 'call/cc (lambda (f k)
37                              (f (lambda (v k2) (k v)) k)))
38             )) 
39 ;------------------------------
40 (eval G (read) identity)

 

用到了racket/match，当然，自己弄一个简单的linear pattern matcher也很容易，不过我就不做让事情复杂化的尝试了。

 

这是前文lambda calculus的例子，一字不变：

 1 ((lambda (zero one add mul pow sub1 true false and or)
 2    ((lambda (sub not zero? two Y)
 3       ((lambda (less-equal? equal? three four)
 4          ;------------------------------
 5          ((lambda (for-each fib)
 6             (for-each (lambda (i) (print (fib zero one zero i))(newline)) zero (mul four four))
 7             )
 8           (Y 
 9             (lambda (self)
10               (lambda (f i n)
11                 (f i)
12                 (((equal? i n)
13                   (lambda () i)
14                   (lambda () (self f (add i one) n))))
15                 )
16               ))
17           (Y 
18             (lambda (self)
19               (lambda (a b i n)
20                 (((equal? i n)
21                   (lambda () a)
22                   (lambda () (self b (add a b) (add i one) n))))
23                 )
24               ))
25           )
26          ;------------------------------
27          )
28        (lambda (m n) (zero? (sub m n)))
29        (lambda (m n) (and (zero? (sub m n)) (zero? (sub n m))))
30        (add two one)
31        (add two two)
32        ))
33     (lambda (m n) (n sub1 m))
34     (lambda (a) (a false true))
35     (lambda (n) (n (lambda (x) false) true))
36     (add one one)
37     (lambda (f)
38       ((lambda (g) (g g))
39        (lambda (g) (f (lambda (a) ((g g) a))))))
40     ))
41  (lambda (f x) x)
42  (lambda (f x) (f x))
43  (lambda (m n f x) (m f (n f x)))
44  (lambda (m n f) (m (n f)))
45  (lambda (e b) (e b))
46  (lambda (n f x) 
47    (((n 
48        (lambda (g h) (h (g f)))) 
49      (lambda (u) x)) 
50     (lambda (u) u)))
51  (lambda (a b) a)
52  (lambda (a b) b)
53  (lambda (a b) (a b a))
54  (lambda (a b) (a a b))
55  )

 

这是yin-yang-puzzle的例子，人肉展开了let*

1 ((lambda (yin)
2    ((lambda (yang)
3       (yin yang))
4     ((lambda (c) (print (lambda (f x) x)) c) 
5      (call/cc (lambda (k) k)))))
6  ((lambda (c) (print (lambda (f x) (f x))) c)
7   (call/cc (lambda (k) k))))