[Scheme]一個Scheme的Metacircular evaluator

這個解釋器能夠用來跑前面兩篇文章的例子,因此一併扔出來,三部曲哈哈。express

 

Lisp內置的S-expression至關於解析好的語法樹,而藉助quasiquote和unquote又很容易進行語法樹層面的變換,因此Lisp的自舉和擴展都很容易。less

相對而言,其餘語言有入門教材就講怎麼實現語言自身的解釋器的嗎?至少命令式語言恐怕不容易,尤爲是中綴表示法的語言,Parser這一關會卡死不少人。ide

 

這個解釋器的典型特性包括currying、call/cc,因此能夠用來跑前面的lambda calculus和yin-yang-puzzle例子:ui

 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也很容易,不過我就不作讓事情複雜化的嘗試了。spa

 

這是前文lambda calculus的例子,一字不變:code

 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*blog

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))))
相關文章
相關標籤/搜索