« Home

用 effect system 實現直釋器 [SW6P]

這是 effect 系列的第二篇，這篇要展示的是用 effect 攔截對 environment 的查詢。所以第一步我們要定義一個攔截 effect

(define lookup-tag (make-continuation-prompt-tag 'lookup))
(define (lookup x)
  (call/cc
    (lambda (k)
      (abort/cc lookup-tag k x))))

第二步我們建立執行函數 EVAL，但我們建立一個 go 輔助函數，讓最上層負責攔截找不到 variables 時的查找，並提供沒有該 variable 的錯誤訊息。這裏跟一般直譯器實現的主要差異就是我們不需要傳 env 這樣的變數，這通常是某個 environment 實現（比如 hashmap 或是 de Bruijn indicies 構成的 list）的實例

(define (go tm)
  (match tm
    [(? symbol? tm) (lookup tm)]
    [(? number? tm) tm]
    [`(+ ,@a) (apply + (map go a))]

綁定變得很容易 [local-0]

可以看到，綁定就變成只是放一個 handler 攔截，遇到查詢就把記錄下來的值丟給 resume 跳回去

    [`(let [,x ,v] ,tm)
     (call/prompt
       go lookup-tag
       (lambda (resume x1)
         (if (eq? x x1)
             (resume (go v))
             (resume (lookup x1))))
       tm)]

那 closure 就變得有點麻煩 [local-2]

但相應的，比起明確在參數中提供 env 變數的版本，我們沒辦法直接把 env 複製進 closure 就好，而是需要特地找出 free variables 並在當前的環境中找到這些變數然後複製成一個 environment。這正是 Lexical scoping 與 dynamic scoping 的對偶的實際案例

    [`(lambda (,x) ,body)
     (define fvs (remove x (remove-duplicates (free-vars body))))
     (closure x body
              (for/list ([y fvs]) (cons y (lookup y))))]

在 application 的部分就需要把存起來的 environment 播放出來變成一系列的 handler

    [`(,f ,a)
     (define fv (go f))
     (define av (go a))
     (match fv
       [(closure x body env)
        (install-env (cons (cons x av) env) body)])]))

closure 的輔助函數 [local-1]

(struct closure (param body env) #:transparent)

(define (free-vars tm)
  (match tm
    [(? symbol? x) (list x)]
    [(? number?) '()]
    [`(+ ,@as) (append-map free-vars as)]
    [`(let [,x ,v] ,t)
     (append (free-vars v) (remove x (free-vars t)))]
    [`(lambda (,x) ,body)
     (remove x (free-vars body))]
    [`(,f ,a)
     (append (free-vars f) (free-vars a))]))

(define (install-env bs tm)
  (match bs
    ['() (go tm)]
    [(cons (cons x v) rest)
     (call/prompt
       (lambda () (install-env rest tm))
       lookup-tag
       (lambda (resume y)
         (if (eq? x y) (resume v) (resume (lookup y)))))]))

EVAL 用來提供錯誤訊息

(define (EVAL tm)
  (call/prompt
    go
    lookup-tag
    (lambda (_resume x)
      (printf "~a is undefined ~n" x))
    tm))

最後我們確認它確實能執行出正確的結果

> (EVAL
    '(let [x 1]
       (let [f (lambda (y) (+ x y))]
         (f 10))))
11