- 浏览: 924752 次
- 性别:
- 来自: 杭州
文章分类
最新评论
-
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 2015远程调用由 ... -
TCP的TIME_WAIT状态
2008-06-23 01:27 4115主动关闭的Socket端会进入TIME_WAIT状态, ... -
善用表驱动法
2008-04-17 19:52 3724最近碰到个需求,计算游戏得分的规则,类似这样: ... -
scheme解决约瑟夫环问题(续)
2008-04-16 10:31 2368sicp的习题3.22,也就是以消息传递的风格重新实现 ... -
lua 5.0的实现(翻译)4,5
2008-04-07 18:00 30234、 表 Table是lua的主要——实际上,也是唯一 ... -
关于binary search
2008-04-02 10:15 2261编程珠玑Column 4关 ... -
scheme解决约瑟夫环问题
2008-03-20 19:18 2575看了javaeye上一个解决约瑟夫环的问题的帖子 ... -
用递归计算阶乘咋不行呢?
2008-03-18 19:40 2728读《代码大全2》 ... -
写操作系统?看看这个(转载)
2008-02-22 17:54 1813今天在pongba的邮件列表里看到了这个《免费电子书& ... -
位图排序
2008-01-07 15:32 2713《编程珠玑》第一章第一题就相当的精彩,做个笔记。题目如 ... -
scheme实现huffman编码的完整代码
2007-07-23 08:56 2540来自sicp的完整代码,包括书中给出的代码以及习题,实 ...
相关推荐
该中文教程详细介绍了scheme语言的语法,规则,是初学者的入门好教材
The scheme programming language scheme语言中的The c programming language.很经典,较第三版增加了不少内容,可读性更强,让您充分体会函数式编程的魅力。
该插件的目的是为专业的Scheme / Lisp开发人员提供健壮的Scheme / Lisp编辑器,他们也碰巧使用Eclipse进行Java编程。 同样,可以对该插件进行子类化和扩展,以提供针对基于Scheme / Lisp的语言的自定义编辑器。 ...
The Scheme Programming Language, Fourth Edition 中文版 翻译的目的,为了自己学习在过程中能够加深印象。并且,给自己积攒一些翻译经验。 希望对大家有所帮助,由于是业余性翻译,用词造句不怎么考究,请大家谅解...
面对对象编程语言:应用和解释 作者 Éric Tanter 译者 MrMathematica、lotuc 本书以建设性和渐进的方式展示了面向对象编程语言的基本概念。它遵循Shriram Krishnamurthi的《编程语言:应用和解释》一书的方法...
可扩展性和灵活性GIMP 通过与许多编程语言(包括 Scheme,Python,Perl 等)集成来提供可扩展性。结果是高级别的自定义,如社区创建的大量脚本和插件所示。自定义界面每个任务都需要不同的环境,GIMP 允许您按照自己...
[Ctrl+A 全选 注:如需引入外部Js需刷新才能执行]JavaScript这种编程语言首要的目的是为Netscape Navigator提供一种页面脚本语言。它仍被普遍的认为是Java的一个子集,但事实并非如此。它是一种语法类似c语言并且...
我刚刚编译了二进制分发版本,当我尝试检出Subversion,我得到一个“Unrecognized URL scheme”错误。 为什么svn revert命令要有一个明确的目标?为什么缺省不是递归的?它的行为方式与大多数其它子命令不同。 当我...
(How to Write a (Lisp) Interpreter (in Python))和(An ((Even Better) Lisp) Interpreter (in Python))的翻译,对解释器实现原理和函数式编程敢兴趣的可以下载看看!
实际上在国外的许多大学中(甚至中学),数据结构和算法分析的课程是选用Scheme(Scheme语言是Lisp的一个现代变种、方言,诞生于1975年)的,例如MIT麻省理工大学极其著名的SICP课程。呵呵,语言又能说明什么呢?...
我刚刚编译了二进制分发版本,当我尝试检出Subversion,我得到一个“Unrecognized URL scheme”错误。 为什么svn revert命令要有一个明确的目标?为什么缺省不是递归的?它的行为方式与大多数其它子命令不同。 当我...
现在网上有很多文件编辑器,这个却是不可多得的一款,不论是日常使用还是手写编程代码,都能让你体会到它独有的优势和方便。 Notepad++ 是在微软视窗环境之下的一个免费的代码编辑器。为了产生小巧且有效率的代码...
因为对于我们这些"自以为是"的"老手"来说,折行都要规定实在太过份了,有时候折行也是我们表达编程思想的一部分好不好 ... 但不管怎样代码的格式化就是 golang 的思想的一部分,这种思想也很无奈的体现到它的开发...