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)
the little schemer 笔记(10.1)的更多相关文章
- the little schemer 笔记(10)
第十章 What Is the Value of All of This? entry条目 是由list表组成的 pair 对,pair 对的第一个list表是集合 set.另外,两个list表的长 ...
- 操作系统概念学习笔记 10 CPU调度
操作系统概念学习笔记 10 CPU调度 多道程序操作系统的基础.通过在进程之间切换CPU.操作系统能够提高计算机的吞吐率. 对于单处理器系统.每次仅仅同意一个进程执行:不论什么其它进程必须等待,直到C ...
- thinkphp学习笔记10—看不懂的路由规则
原文:thinkphp学习笔记10-看不懂的路由规则 路由这部分貌似在实际工作中没有怎么设计过,只是在用默认的设置,在手册里面看到部分,艰涩难懂. 1.路由定义 要使用路由功能需要支持PATH_INF ...
- 《C++ Primer Plus》学习笔记10
<C++ Primer Plus>学习笔记10 <<<<<<<<<<<<<<<<<&l ...
- SQL反模式学习笔记10 取整错误
目标:使用小数取代整数 反模式:使用Float类型 根据IEEE754标识,float类型使用二进制格式编码实数数据. 缺点:(1)舍入的必要性: 并不是所有的十进制中描述的信息都能使用二进制存储,处 ...
- JAVA自学笔记10
JAVA自学笔记10 1.形式参数与返回值 1)类名作为形式参数(基本类型.引用类型) 作形参必须是类的对象 2)抽象类名作形参 需要该抽象类的子类对象,通过多态实现 3)接口名为形参 需要的是该接口 ...
- golang学习笔记10 beego api 用jwt验证auth2 token 获取解码信息
golang学习笔记10 beego api 用jwt验证auth2 token 获取解码信息 Json web token (JWT), 是为了在网络应用环境间传递声明而执行的一种基于JSON的开放 ...
- Spring MVC 学习笔记10 —— 实现简单的用户管理(4.3)用户登录显示全局异常信息
</pre>Spring MVC 学习笔记10 -- 实现简单的用户管理(4.3)用户登录--显示全局异常信息<p></p><p></p>& ...
- Python标准库笔记(10) — itertools模块
itertools 用于更高效地创建迭代器的函数工具. itertools 提供的功能受Clojure,Haskell,APL和SML等函数式编程语言的类似功能的启发.它们的目的是快速有效地使用内存, ...
随机推荐
- 记录魅族m1note编译TWRP recovery 3.1.0-0,包括mtk机型的处理方法
1.安装64位linux系统,我用的是deepin os 15.3 2.将系统升级到最新版本 sudo apt-get update && sudo apt-get upgrade 3 ...
- IBM中国研究院、SAP、网易游戏、IBM2015应届生招聘笔试面试问题分享
IBM中国研究院实习生 早在今年4月份.我面试的是IBM中国研究院的实习生岗位.主要是自然语言处理和语义网方向.那时我还在香港上学,两个考官对我进行的是电话面试,大概持续半个多小时,首先是我的自我介绍 ...
- LeetCode 112 Path Sum(路径和)(BT、DP)(*)
翻译 给定一个二叉树root和一个和sum, 决定这个树是否存在一条从根到叶子的路径使得沿路全部节点的和等于给定的sum. 比如: 给定例如以下二叉树和sum=22. 5 / \ 4 8 / / \ ...
- Drupal 7模板(主题钩子)的建议
这一块的内容很多其它的讲的是样例.所以这里请直接稳步官方站点查看吧.链接 https://drupal.org/node/1089656
- 使用 fetch 代替 ajax(在不支持的浏览器上使用 XHR); This kind of functionality was previously achieved using XMLHttpRequest.
原生 JS Ajax,GET和POST 请求实例代码_javascript技巧_脚本之家 https://www.jb51.net/article/86157.htm 更新时间:2016年06月08日 ...
- the hard problems when writing a great connector; type cohersion, data partitioning and data locality to name a few
http://rosslawley.co.uk/introducing-a-new=mongodb-spark-connector/
- RubyMine安装、破解
经常安装东西,这是我安装过最快的ide破解版. 下载地址: http://www.jetbrains.com/ruby/download/index.html 破解序列号: name: rubymin ...
- Get Luffy Out (poj 2723 二分+2-SAT)
Language: Default Get Luffy Out Time Limit: 2000MS Memory Limit: 65536K Total Submissions: 7969 ...
- jquery1.9是最后支持IE678
bootstrap 需要 jquery 1.9.1或更高 jquery1.9是最后支持IE678
- jquery清空div里所有input输入框的值
$("#divId input").val("");