the little schemer 笔记(10.1)
This work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 2.5 China Mainland License.
下面是 the little schemer 中的 简单interpreter实现以及在DrRacket中的一步步的调试观察。
这里注意运行下面的代码需要设置一下
另外，使用DrRacket的调试来step by step 观察 Scheme 程序运行非常不错。
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;a simple scheme interpreter run on scheme (DrRacket 5.3)
;date:2012-9-3
;some trivil functions
(define (atom? x)
(and (not (null? x))
(not (pair? x))))
(define first
(lambda (p)
(car p)))
(define second
(lambda (p)
(car (cdr p))))
(define third
(lambda (p)
(car (cdr (cdr p)))))
(define build
(lambda (s1 s2)
(cons s1 (cons s2 (quote ())))))
(define new-entry build)
;entry and table
(define lookup-in-entry-help
(lambda (name names values entry-f)
(cond
((null? names) (entry-f name))
((eq? (car names) name) (car values))
(else (lookup-in-entry-help name (cdr names) (cdr values) entry-f)))))
(define lookup-in-entry
(lambda (name entry entry-f)
(lookup-in-entry-help name
(first entry)
(second entry)
entry-f)))
(define extend-table cons)
(define lookup-in-table
(lambda (name table table-f)
(cond
((null? table) (table-f name))
(else (lookup-in-entry name
(car table)
(lambda (name)
(lookup-in-table name (cdr table) table-f)))))))
;;;;;;;;;;;actions
(define atom-to-action
(lambda (e)
(cond
((number? e) *const)
((eq? e #t) *const)
((eq? e (quote cons)) *const)
((eq? e (quote car)) *const)
((eq? e (quote cdr)) *const)
((eq? e (quote null?)) *const)
((eq? e (quote eq?)) *const)
((eq? e (quote atom?)) *const)
((eq? e (quote zero?)) *const)
((eq? e (quote add1)) *const)
((eq? e (quote sub1)) *const)
((eq? e (quote number?)) *const)
(else *identifier))))
(define list-to-action
(lambda (e)
(cond
((atom? (car e))
(cond
((eq? (car e) (quote quote)) *quote)
((eq? (car e) (quote lambda)) *lambda)
((eq? (car e) (quote cond)) *cond)
(else *application)))
(else *application))))
(define expression-to-action
(lambda (e)
(cond
((atom? e) (atom-to-action e))
(else (list-to-action e)))))
;*const action
(define *const
(lambda (e table)
(cond
((number? e) e)
((eq? e #t) #t)
((eq? e #f) #f)
(else (build (quote primitive) e)))))
;*quote action
(define text-of second)
(define *quote
(lambda (e table)
(text-of e)))
;identifier action
(define initial-table
(lambda (name)
(car (quote ()))))
(define *identifier
(lambda (e table)
(lookup-in-table e table initial-table)))
;*lambda action
(define *lambda
(lambda (e table)
(build (quote non-primitive)
(cons table (cdr e)))))
;*cond action
(define table-of first)
(define formals-of second)
(define body-of third)
(define else?
(lambda (x)
(cond
((atom? x) (eq? x (quote else)))
(else #f))))
(define question-of first)
(define answer-of second)
(define evcon
(lambda (lines table)
(cond
((else? (question-of (car lines)))
(meaning (answer-of (car lines)) table))
((meaning (question-of (car lines)) table)
(meaning (answer-of (car lines)) table))
(else (evcon (cdr lines) table)))))
(define cond-lines-of cdr)
(define *cond
(lambda (e table)
(evcon (cond-lines-of e) table)))
;*application action
(define evlis
(lambda (args table)
(cond
((null? args) (quote ()))
(else
(cons (meaning (car args) table)
(evlis (cdr args) table))))))
(define function-of car)
(define arguments-of cdr)
(define primitive?
(lambda (l)
(eq? (first l) (quote primitive))))
(define non-primitive?
(lambda (l)
(eq? (first l) (quote non-primitive))))
(define :atom?
(lambda (x)
(cond
((atom? x) #t)
((null? x) #t)
((eq? (car x) (quote primitive)) #t)
(else #f))))
(define apply-primitive
(lambda (name vals)
(cond
((eq? name (quote cons))
(cons (first vals) (second vals)))
((eq? name (quote car))
(car (first vals)))
((eq? name (quote vals))
(cdr (first vals)))
((eq? name (quote null?))
(null? (first vals)))
((eq? name (quote eq?))
(eq? (first (second vals))))
((eq? name (quote atom?))
(:atom? (first vals)))
((eq? name (quote zero?))
(zero? (first vals)))
((eq? name (quote add1))
(add1 (first vals)))
((eq? name (quote sub1))
(sub1 (first vals)))
((eq? name (quote number?))
(number? (first vals))))))
(define apply-closure
(lambda (closure vals)
(meaning (body-of closure)
(extend-table
(new-entry (formals-of closure) vals) (table-of closure)))))
(define apply
(lambda (fun vals)
(cond
((primitive? fun)
(apply-primitive (second fun) vals))
((non-primitive? fun) (apply-closure (second fun) vals)))))
(define *application
(lambda (e table)
(apply
(meaning (function-of e) table)
(evlis (arguments-of e) table))))
;;;;;;;;;value--the interpreter entrance
(define meaning
(lambda (e table)
((expression-to-action e) e table)))
(define value
(lambda (e)
(meaning e (quote ()))))
;;;;test examples;;;
;;DrRacket中注释代码COMMENT in DrRacket: select codes and press ctrl + alt + ";"
;;DrRacket中取消注释UNCOMMENT in DrRacket: select codes and press ctrl + alt + "="
;example1.(meaning e table)是什么,其中e是(lambda (x) (cons x y)),table 是(((y z) ((8) 9)))。
;(define e '(lambda (x) (cons x y)))
;(define table '(((y z) ((8) 9))))
;(meaning e table)
;example2.(*cond e table), 其中e是(cond (coffee klastsch) (else party)), table 是 (((coffee) (#t)) ((klastsch party) (5 (6))))
;(define e '(cond (coffee klastsch) (else party)))
;(define table '(((coffee) (#t)) ((klastsch party) (5 (6)))))
;(*cond e table)
;example3.
(define e '((lambda (nothing)
(cond
(nothing (quote something))
(else (quote nothing))))
#t))
(value e)
最新文章
- 微信小程序开发初探
- (转)REDIS各项配置参数介绍
- 使用JDBC实现Oracle用户认证
- java 事件处理机制：按下上下左右键控制小球的运动
- TI CC2541的引脚中断.
- APPDelegate----launchOptions启动类型
- jquery的上传控件uploadly,每行都有一个这样的控件对id选择器的使用
- bzoj 2820 YY的GCD（莫比乌斯反演）
- 【转】MyBatis中Like语句使用方式
- Java学习日记-11 集合（1）
- awk笔记1
- 文件下载 .net
- 【转】Hive执行计划
- Python之函数知识
- python进阶（3）：模块和包
- Maven 环境配置
- Hibernate入门(二)——hibernateAPI详解
- 【托业】【新东方托业全真模拟】TEST07~08-----P5~6
- 《pyhton语言程序设计》_第一章笔记
- Appium——处理混合APP中H5的操作