受javaeye上的《
》启发,帖子中有人提到如果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
“使得”就是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)
'))
(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)
- 2009-03-20 23:27
- 浏览 3844
- 评论(2)
- 论坛回复 / 浏览 (1 / 4498)
- 分类:编程语言
相关推荐
该中文教程详细介绍了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 的思想的一部分,这种思想也很无奈的体现到它的开发...