- 浏览: 929854 次
- 性别:
- 来自: 杭州
-
文章分类
最新评论
-
hw7777777:
非常感谢作者提供这么好的工具,在使用的过程中遇到一些问题?1、 ...
基于java nio的memcached客户端——xmemcached -
SINCE1978:
多久过去了时间能抹平一切
无路用的人 -
fangruanyjq:
[img][/img]引用
用osworkflow写一个请假例子(提供代码下载) -
thinkingmysky:
楼主,你确定,java memached client能处理并 ...
memcached java client性能测试的几点疑问和说明 -
hellostory:
aaa5131421 写道07年2月hibernate已经出来 ...
dozer与BeanUtils
受javaeye上的《Ruby中文编程 》启发,帖子中有人提到如果if这样的关键字都可以定义成中文,那就是真正的中文编程。那时我就想到,这个其实要在scheme中实现是多么简单,将sicp书中的解释器稍微修改下就可以了,只要修改解析的部分即可。解释器的完整代码放后面,我们先看看有趣的例子:
<!---->(定义 你
'
男)
(当 ((是 你 ' 男) (打印 ' 男人是泥土做的))
((是 你 ' 女) (打印 ' 女人是水做的))
(否则
(打印 ' 妖怪啊)))
(当 ((是 你 ' 男) (打印 ' 男人是泥土做的))
((是 你 ' 女) (打印 ' 女人是水做的))
(否则
(打印 ' 妖怪啊)))
其实呢,“定义”等价于define,“当”等价于cond,“打印”等价于display,说穿了不值一提,只是有趣罢了。不过设想在某些效率不是攸关的场景嵌入这么一个scheme解释器来定义DSL给业务人员使用,似乎也是不错的主意。当然这里还是scheme的前缀表达式,再修改下就可以像自然语言那样流畅,只不过括号还是少不了呀。
再看几个例子:
<!---->(使得 ((a
3
)
(b 2 ))
( + a b))
(定义 成绩 90 )
(如果 ( > 成绩 80 )
(打印 ' 良好)
(打印 ' 要打PP了))
((函数(x) (* x x)) 3) => 9
(定义 (平方 x) (* x x))
(平方 3) =>9
(b 2 ))
( + a b))
(定义 成绩 90 )
(如果 ( > 成绩 80 )
(打印 ' 良好)
(打印 ' 要打PP了))
((函数(x) (* x x)) 3) => 9
(定义 (平方 x) (* x x))
(平方 3) =>9
“使得”就是let,如果就是if,函数就是lambda。这不是中文编程吗?也许可以考虑申请国家专项资金来扶持:D
完整的解释器代码,在drscheme选择R5RS标准下测试通过:
(define apply-in-underlying-scheme apply) (define (eval exp env) ((analyze exp) env)) (define (analyze exp) (cond ((self-evaluating? exp) (analyze-self-evaluating exp)) ((quoted? exp) (analyze-quoted exp)) ((variable? exp) (analyze-variable exp)) ((assignment? exp) (analyze-assignment exp)) ((definition? exp) (analyze-definition exp)) ((if? exp) (analyze-if exp)) ((lambda? exp) (analyze-lambda exp)) ((begin? exp) (analyze-sequence (begin-actions exp))) ((cond? exp) (analyze (cond->if exp))) ((let? exp) (analyze (let->combination exp))) ((application? exp)(analyze-application exp)) (else (error "Unknown expression type--ANALYZE" exp)))) (define (apply procedure arguments) (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) ((compound-procedure? procedure) (eval-sequence (procedure-body procedure) (extend-environment (procedure-parameters procedure) arguments (procedure-environment procedure)))) (else (error "Unknown procedure type --APPLY" procedure)))) (define (self-evaluating? exp) (cond ((number? exp) #t) ((string? exp) #t) (else #f))) (define (variable? exp) (symbol? exp)) (define (quoted? exp) (tagged-list? exp 'quote)) (define (text-of-quotation exp) (cadr exp)) (define (tagged-list? exp tag) (if (pair? exp) (eq? (car exp) tag) #f)) (define (assignment? exp) (tagged-list? exp '设置)) (define (assignment-variable exp) (cadr exp)) (define (assignment-value exp) (caddr exp)) (define (definition? exp) (tagged-list? exp '定义)) (define (definition-variable exp) (if (symbol? (cadr exp)) (cadr exp) (caadr exp))) (define (definition-value exp) (if (symbol? (cadr exp)) (caddr exp) (make-lambda (cdadr exp) (cddr exp)))) (define (lambda? exp) (tagged-list? exp '函数)) (define (lambda-parameters exp) (cadr exp)) (define (lambda-body exp) (cddr exp)) (define (make-lambda parameters body) (cons '函数 (cons parameters body))) (define (if? exp) (tagged-list? exp '如果)) (define (if-predicate exp) (cadr exp)) (define (if-consequent exp) (caddr exp)) (define (if-alternative exp) (if (not (null? (cdddr exp))) (cadddr exp) 'false)) (define (make-if predicate consequent alternative) (list '如果 predicate consequent alternative)) (define (begin? exp) (tagged-list? exp '开始)) (define (begin-actions exp) (cdr exp)) (define (last-exp? exps) (null? (cdr exps))) (define (first-exp exps) (car exps)) (define (rest-exps exps) (cdr exps)) (define (make-begin seq) (cons '开始 seq)) (define (sequence->exp seq) (cond ((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))) (define (application? exp) (pair? exp)) (define (operator exp) (car exp)) (define (operands exp) (cdr exp)) (define (no-operands? ops) (null? ops)) (define (first-operand ops) (car ops)) (define (rest-operands ops) (cdr ops)) (define (let? exp) (tagged-list? exp '使得)) (define (make-define var parameters body) (list '定义 (cons var parameters) body)) (define (let->combination exp) (if (symbol? (cadr exp)) (let ((var (cadr exp)) (vars (map car (caddr exp))) (vals (map cadr (caddr exp))) (pairs (caddr exp)) (body (cadddr exp))) (cons (make-lambda vars (list (make-define var vars body) body)) vals)) (let ((vars (map car (cadr exp))) (vals (map cadr (cadr exp))) (body (caddr exp))) (cons (make-lambda vars (list body)) vals)))) (define (cond? exp) (tagged-list? exp '当)) (define (cond-clauses exp) (cdr exp)) (define (cond-else-clauses? clause) (eq? (cond-predicate clause) '否则)) (define (cond-extended-clauses? clause) (and (> (length clause) 2) (eq? (cadr clause) '=>))) (define (extended-cond-test clause) (car clause)) (define (extended-cond-recipient clause) (caddr clause)) (define (cond-predicate clause) (car clause)) (define (cond-actions clause) (cdr clause)) (define (cond->if exp) (expand-clauses (cond-clauses exp))) (define (expand-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (cond ((cond-else-clauses? first) (if (null? rest) (sequence->exp (cond-actions first)) (error "else clause is not LAST" clauses))) ((cond-extended-clauses? first) (make-if (extended-cond-test first) (list (extended-cond-recipient first) (extended-cond-test first)) (expand-clauses rest))) (else (make-if (cond-predicate first) (sequence->exp (cond-actions first)) (expand-clauses rest))))))) (define (true? exp) (or (eq? exp 'true) exp)) (define (false? exp) (or (eq? exp 'false) exp)) (define (make-procedure parameters body env) (list 'procedure parameters body env)) (define (compound-procedure? p) (tagged-list? p 'procedure)) (define (procedure-parameters p) (cadr p)) (define (procedure-body p) (caddr p)) (define (procedure-environment p) (cadddr p)) (define (enclosing-environment env) (cdr env)) (define (first-frame env) (car env)) (define the-empty-environment '()) (define (make-frame variables values) (cons variables values)) (define (frame-variables f) (car f)) (define (frame-values f) (cdr f)) (define (add-binding-to-frame! var val frame) (set-car! frame (cons var (car frame))) (set-cdr! frame (cons val (cdr frame)))) (define (extend-environment vars vals base-env) (if (= (length vars) (length vals)) (cons (make-frame vars vals) base-env) (if (< (length vars) (length vals)) (error "Too many arguments supplied" vars vals) (error "Too few arguments supplied" vars vals)))) (define (lookup-variable-value var env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (car vals)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (set-variable-value! var val env) (define (env-loop env) (define (scan vars vals) (cond ((null? vars) (env-loop (enclosing-environment env))) ((eq? var (car vars)) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (if (eq? env the-empty-environment) (error "Unbound variable --SET!" var) (let ((frame (first-frame env))) (scan (frame-variables frame) (frame-values frame))))) (env-loop env)) (define (define-variable! var val env) (let ((frame (first-frame env))) (define (scan vars vals) (cond ((null? vars) (add-binding-to-frame! var val frame)) ((eq? (car vars) var) (set-car! vals val)) (else (scan (cdr vars) (cdr vals))))) (scan (frame-variables frame) (frame-values frame)))) (define (primitive-procedure? p) (tagged-list? p 'primitive)) (define (primitive-implementation proc) (cadr proc)) (define primitive-procedures (list (list 'car car) (list 'cdr cdr) (list 'cons cons) (list 'null? null?) (list '+ +) (list '- -) (list '* *) (list '/ /) (list '< <) (list '> >) (list '是 equal?) (list '= =) (list 'assoc assoc) (list 'cadr cadr) (list 'cadr caddr) (list '打印 display) (list '换行 newline) (list '映射 map))) (define (primitive-procedure-names) (map car primitive-procedures) ) (define (primitive-procedure-objects) (map (lambda(proc) (list 'primitive (cadr proc))) primitive-procedures)) (define (setup-environment) (let ((initial-env (extend-environment (primitive-procedure-names) (primitive-procedure-objects) the-empty-environment))) (define-variable! 'true #t initial-env) (define-variable! 'false #f initial-env) initial-env)) (define the-global-environment (setup-environment)) (define (apply-primitive-procedure proc args) (apply-in-underlying-scheme (primitive-implementation proc) args)) (define input-prompt ";;; M-Eval input:") (define out-prompt ";;; M-Eval value:") (define (prompt-for-input string) (newline) (newline) (display string) (newline)) (define (announce-output string) (newline) (display string) (newline)) (define (user-print object) (if (compound-procedure? object) (display (list 'compound-procedure (procedure-parameters object) (procedure-body object) '<procedure-env>)) (display object))) (define (drive-loop) (prompt-for-input input-prompt) (let ((input (read))) (let ((output (eval input the-global-environment))) (announce-output out-prompt) (user-print output))) (drive-loop)) ;接下来是分析过程 (define (analyze-self-evaluating exp) (lambda(env) exp)) (define (analyze-variable exp) (lambda(env) (lookup-variable-value exp env))) (define (analyze-quoted exp) (let ((qval (text-of-quotation exp))) (lambda(env) qval))) (define (analyze-assignment exp) (let ((var (assignment-variable exp)) (vproc (analyze (assignment-value exp)))) (lambda(env) (set-variable-value! var (vproc env) env) 'ok))) (define (analyze-definition exp) (let ((var (definition-variable exp)) (vproc (analyze (definition-value exp)))) (lambda(env) (define-variable! var (vproc env) env) 'ok))) (define (analyze-if exp) (let ((pproc (analyze (if-predicate exp))) (cproc (analyze (if-consequent exp))) (aproc (analyze (if-alternative exp)))) (lambda(env) (if (true? (pproc env)) (cproc env) (aproc env))))) (define (analyze-lambda exp) (let ((vars (lambda-parameters exp)) (bproc (analyze-sequence (lambda-body exp)))) (lambda(env) (make-procedure vars bproc env)))) (define (analyze-sequence exps) (define (sequentially proc1 proc2) (lambda(env) (proc1 env) (proc2 env))) (define (loop first-proc rest-proc) (if (null? rest-proc) first-proc (loop (sequentially first-proc (car rest-proc)) (cdr rest-proc)))) (let ((procs (map analyze exps)) ) (if (null? procs) (error "Empty sequence --ANALYZE") (loop (car procs) (cdr procs))))) (define (analyze-application exp) (let ((fproc (analyze (operator exp))) (aprocs (map analyze (operands exp)))) (lambda(env) (execution-application (fproc env) (map (lambda (aproc) (aproc env)) aprocs))))) (define (execution-application proc args) (cond ((primitive-procedure? proc) (apply-primitive-procedure proc args)) ((compound-procedure? proc) ((procedure-body proc) (extend-environment (procedure-parameters proc) args (procedure-environment proc)))) (else (error "Unknown procedure type --EXECUTE--APPLICATION" proc)))) (drive-loop)
发表评论
-
远程调用的语义
2008-08-19 23:51 2039远程调用由 ... -
TCP的TIME_WAIT状态
2008-06-23 01:27 4133主动关闭的Socket端会进入TIME_WAIT状态, ... -
善用表驱动法
2008-04-17 19:52 3755最近碰到个需求,计算游戏得分的规则,类似这样: ... -
scheme解决约瑟夫环问题(续)
2008-04-16 10:31 2396sicp的习题3.22,也就是以消息传递的风格重新实现 ... -
lua 5.0的实现(翻译)4,5
2008-04-07 18:00 30404、 表 Table是lua的主要——实际上,也是唯一 ... -
关于binary search
2008-04-02 10:15 2282编程珠玑Column 4关 ... -
scheme解决约瑟夫环问题
2008-03-20 19:18 2596看了javaeye上一个解决约瑟夫环的问题的帖子 ... -
用递归计算阶乘咋不行呢?
2008-03-18 19:40 2757读《代码大全2》 ... -
写操作系统?看看这个(转载)
2008-02-22 17:54 1843今天在pongba的邮件列表里看到了这个《免费电子书& ... -
位图排序
2008-01-07 15:32 2726《编程珠玑》第一章第一题就相当的精彩,做个笔记。题目如 ... -
scheme实现huffman编码的完整代码
2007-07-23 08:56 2557来自sicp的完整代码,包括书中给出的代码以及习题,实 ...
相关推荐
Fluent Scheme 中文手册修订 Fluent Scheme 是一种基于 ...Fluent Scheme 中文手册修订为用户提供了一个详细的编程指南,涵盖了 Fluent Scheme 的基本概念、接口机制、变量类型、数学函数、控制结构等方面的知识点。
该中文教程详细介绍了scheme语言的语法,规则,是初学者的入门好教材
《Scheme编程语言》是Lisp家族中的一种简洁且强大的方言,以其简洁的语法、高效的实现以及对函数式编程的强大支持而闻名。 Scheme是基于λ演算的,这使得它非常适合进行计算机科学的基础教学,同时也被广泛用于研究...
这本书的中文名通常被译为《小.Scheme程序员》。压缩包中的资源提供了书中实例代码、一个Windows下的Scheme运行环境以及其姊妹篇《The Seasoned Schemer》的PDF电子版。 1. **Scheme编程语言**:Scheme是Lisp家族的...
The scheme programming language scheme语言中的The c programming language.很经典,较第三版增加了不少内容,可读性更强,让您充分体会函数式编程的魅力。
总的来说,Color Scheme Designer是一款强大的在线设计工具,通过其简洁的中文界面和高效的功能,使得设计师能够快速创建出和谐且富有创意的颜色搭配。而压缩包中的文件结构则揭示了网页应用的构建方式,包括HTML...
该插件的目的是为专业的Scheme / Lisp开发人员提供健壮的Scheme / Lisp编辑器,他们也碰巧使用Eclipse进行Java编程。 同样,可以对该插件进行子类化和扩展,以提供针对基于Scheme / Lisp的语言的自定义编辑器。 ...
LISP语言及其方言如Scheme、Clojure等,以及后来的APL、FP、ML、OCaml、Standard ML等,都在函数式编程领域扮演了重要角色。这些语言的设计和演变反映了函数式编程思想的深化和扩展,例如惰性求值、多态类型系统和高...
两者都有其独特优点,Scheme注重简洁性,适合学习编程原理,而Common Lisp则提供了大量内置库和工具,支持大型项目开发。 **Practical Common Lisp** 《Practical Common Lisp》是一本由Peter Seibel编写的经典...
在书中,作者选取了七种截然不同的编程语言进行讲解,分别是:Lisp、Scheme、Python、Prolog、Ruby、Haskell和Java。每种语言都代表了一种或几种编程范式,如函数式、命令式、逻辑式和面向对象。通过学习这些语言,...
本书的第二版包含了中文和英文两个版本,旨在帮助读者理解计算机程序的本质,以及如何通过Lisp和Scheme语言来构建和解释这些程序。 Lisp是一种古老而强大的编程语言,以其独特的括号语法和函数式编程特性而著名。它...
《函数式编程思维》中文版是一本深入探讨函数式编程思想的书籍,旨在帮助读者理解并掌握这种编程范式的核心理念。函数式编程是计算机科学中的一个重要领域,它强调使用数学函数来解决问题,通过避免可变状态和副作用...
在Swift编程环境中,使用Xcode进行开发时,我们经常需要通过控制台输出信息来调试代码。当涉及到中文字符时,可能会遇到一些问题,比如乱码或者无法正常显示。本篇文章将详细探讨如何在Xcode的控制台正确地输出中文...
The Scheme Programming Language, Fourth Edition 中文版 翻译的目的,为了自己学习在过程中能够加深印象。并且,给自己积攒一些翻译经验。 希望对大家有所帮助,由于是业余性翻译,用词造句不怎么考究,请大家谅解...
这本《Lisp函数参考大全中文版》不仅涵盖了上述的基本概念,还可能深入到各种Lisp方言的特性和高级主题,如Common Lisp、Scheme或Emacs Lisp的特定库和功能。通过详尽的示例和解释,读者可以更好地理解和运用Lisp的...
面对对象编程语言:应用和解释 作者 Éric Tanter 译者 MrMathematica、lotuc 本书以建设性和渐进的方式展示了面向对象编程语言的基本概念。它遵循Shriram Krishnamurthi的《编程语言:应用和解释》一书的方法...
这两款字体结合了中英文的优秀特性,既适合中文环境,也适应英文编码需求,对于双语编程或需要同时处理中英文文本的开发者来说,是非常理想的选择。它们可能具有优化的字形设计,如加大空格、清晰的笔画收尾,以及对...
它的设计深受 S 语言和 Scheme 语言的影响,因此在语法和使用上与 S 语言有很高的相似性。R 提供了一个全面的环境,不仅包含了丰富的统计分析工具,还支持自定义图形绘制,使得用户能够进行复杂的统计建模和数据可视...
* UDF 中调用 Scheme/TUI 命令:只有企业版支持 * 与 Matlab 耦合迭代计算:只有企业版支持 Visual Studio 安装注意事项 1. 建议 Visual C# 与 Visual C++ 同时安装。 2. 对于 VS2008,安装时请勾选“Visual C++ ...
第二版》(HTDP)是一本由马修·史纳金(Matthew Flatt)、马尔科姆·派特森(Robby Findler)和克里斯托弗·哈特曼(Chris Harman)等人合著的编程教材,主要针对初学者,旨在教授如何使用Scheme编程语言进行程序...