Chinaunix首页 | 论坛 | 认证专区 | 博客 登录 | 注册

freearth\'s blog: 系统技术与分布式计算freearth.blog.chinaunix.net

如果你是个木匠,正在打造一个漂亮的五斗柜,你是不会在柜子后面用三合板的,哪怕那一面对着墙,永远没人看到它。你知道它在那里,所以即使是柜子后面,你也会用上好的木材。为了能在晚上睡个好觉,你会在审美和质量上自始至终争取做到最好。

  • 博客访问: 716965
  • 博文数量: 129
  • 博客积分: 3715
  • 博客等级: 中校
  • 技术积分: 1867
  • 用 户 组: 普通用户
  • 注册时间: 2006-04-30 08:38
文章分类

全部博文(129)

文章存档

2013年(1)

2012年(9)

2011年(43)

2010年(3)

2009年(4)

2008年(51)

2007年(18)

微信关注

IT168企业级官微



微信号:IT168qiye



系统架构师大会



微信号:SACC2013

订阅
热词专题
一个简单的元循环解释器 2012-07-12 23:27:23

分类: Python/Ruby

本文定义了元循环解释器。支持变量定义、修改、闭包、函数应用、字符串、数字等。

事实上,一个最小的、图灵完全的元循环解释器。它只需要包含三个操作:
1. 名字(变量)的引用;
2. 定义有且只有一个参数的匿名函数(闭包);
3. 在一个参数上应用(调用)一个匿名函数;

关于该解释器的图灵完全性,可以参考博文“Church计数的简单实现“。

  1. #lang racket/base
  2. (require racket/match)

  3. ;; cell for a single variable binding
  4. (struct cell ((value #:mutable)) #:transparent)

  5. ;; special undefined value
  6. (define undefined (cell 'undefined))

  7. ;; environment and operation
  8. (define (empty-env) (hash))

  9. ;; extends env with vars and their values
  10. ;; (eq? (length vars) (length values)) => true
  11. (define (extend-env env vars values)
  12.   (match `(,vars ,values)
  13.     (`((,var . ,vars) (,value . ,values))
  14.       (extend-env (hash-set env
  15.                             var
  16.                             (cell value))
  17.                   vars values))
  18.     ('(() ()) env)))

  19. ;; define the initial env bindings
  20. (define primitive-vars
  21.         '(+ - * / printf void))
  22. (define primitive-values
  23.         (map (lambda (s) (list 'primitive s))
  24.              (list + - * / printf void)))

  25. (define (initial-env)
  26.   (extend-env (empty-env)
  27.               primitive-vars
  28.               primitive-values))

  29. ;; lookup env for var, return 'undefined if not exists
  30. (define (env-lookup env var)
  31.   (cell-value (hash-ref env var undefined)))

  32. ;; set! var of env
  33. (define (env-set! env var value)
  34.   (let ((cell (hash-ref env var undefined)))
  35.        (if (eq? undefined cell)
  36.            (error "set! a undefined var")
  37.            (set-cell-value! cell value))))

  38. ;; let's do the eval / apply magic
  39. (define (core-eval expr env)
  40.   (match expr
  41.     ((? symbol?) (env-lookup env expr))
  42.     ((? number?) expr)
  43.     ((? string?) expr)
  44.     ((? boolean?) expr)

  45.     (`(if ,condition ,then ,else) (if (core-eval condition env)
  46.                                       (core-eval then env)
  47.                                       (core-eval else env)))

  48.     (`(lambda ,vars ,body) `(closure ,expr ,env))
  49.     (`( ,var ,e) (env- env var (core-eval e env)))

  50.     (`(let ,binds ,body) (core-eval body
  51.                                     (extend-env env
  52.                                                 (map car binds)
  53.                                                 (map cadr binds))))

  54.     (`(begin ,e1 ,e2) (begin
  55.                         (core-eval e1 env)
  56.                         (core-eval e2 env)))

  57.     (`(,expf . ,expvs) (core-apply (core-eval expf env)
  58.                                    (map (lambda (expv) (core-eval expv env)) expvs)))))

  59. (define (core-apply closure values)
  60.   (match closure
  61.     (`(closure (lambda ,vars ,body) ,env)
  62.      (core-eval body
  63.                 (extend-env env vars values)))
  64.     (`(primitive ,f) (apply f values))))

  65. ;; main starts here
  66. (let loop ((s-exp (read)))
  67.      (if (eof-object? s-exp)
  68.          (void)
  69.          (begin
  70.            (core-eval s-exp (initial-env))
  71.            (loop (read)))))

阅读(11145) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~
评论热议
请登录后评论。

登录 注册