[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))))
【推荐】编程新体验,更懂你的AI,立即体验豆包MarsCode编程助手
【推荐】凌霞软件回馈社区,博客园 & 1Panel & Halo 联合会员上线
【推荐】抖音旗下AI助手豆包,你的智能百科全书,全免费不限次数
【推荐】轻量又高性能的 SSH 工具 IShell:AI 加持,快人一步