一个简单的元循环解释器

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

事实上，一个最小的、图灵完全的元循环解释器。它只需要包含三个操作：

1. 名字（变量）的引用；

2. 定义有且只有一个参数的匿名函数（闭包）；

3. 在一个参数上应用（调用）一个匿名函数；

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

#lang racket/base
(require racket/match)

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

;; special undefined value
(define undefined (cell 'undefined))

;; environment and operation
(define (empty-env) (hash))

;; extends env with vars and their values
;; (eq? (length vars) (length values)) => true
(define (extend-env env vars values)
  (match `(,vars ,values)
    (`((,var . ,vars) (,value . ,values))
      (extend-env (hash-set env
                            var
                            (cell value))
                  vars values))
    ('(() ()) env)))

;; define the initial env bindings
(define primitive-vars
        '(+ - * / printf void))
(define primitive-values
        (map (lambda (s) (list 'primitive s))
             (list + - * / printf void)))

(define (initial-env)
  (extend-env (empty-env)
              primitive-vars
              primitive-values))

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

;; set! var of env
(define (env-set! env var value)
  (let ((cell (hash-ref env var undefined)))
       (if (eq? undefined cell)
           (error "set! a undefined var")
           (set-cell-value! cell value))))

;; let's do the eval / apply magic
(define (core-eval expr env)
  (match expr
    ((? symbol?) (env-lookup env expr))
    ((? number?) expr)
    ((? string?) expr)
    ((? boolean?) expr)

    (`(if ,condition ,then ,else) (if (core-eval condition env)
                                      (core-eval then env)
                                      (core-eval else env)))

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

    (`(let ,binds ,body) (core-eval body
                                    (extend-env env
                                                (map car binds)
                                                (map cadr binds))))

    (`(begin ,e1 ,e2) (begin
                        (core-eval e1 env)
                        (core-eval e2 env)))

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

(define (core-apply closure values)
  (match closure
    (`(closure (lambda ,vars ,body) ,env)
     (core-eval body
                (extend-env env vars values)))
    (`(primitive ,f) (apply f values))))

;; main starts here
(let loop ((s-exp (read)))
     (if (eof-object? s-exp)
         (void)
         (begin
           (core-eval s-exp (initial-env))
           (loop (read)))))