これはLisp Advent Calendar 2019 21日目の記事です.

Typed Racketでmeta-circular evaluatorを作ろう

SICPはお好きですか? 私自身は楽しんで読んでいるのですが, 読み進めていくうちに, いろんな場面での自分の現在の設計思想を明らかにするために, 本の中のように多量の文章の代わりに型があったらどうなるんだろうと考え出すようになりました. Untyped Racketを用いて読み進めてみたので, それならいっそのことTyped Racketを用いてみようじゃないかということになってお型付け生活を始めてみました.

今回は, Typed Racketを用いてmeta-circular evaluatorをお型付けしてみた試みのうち, Environment構造の部分をお見せしたいと思います. コード全体はまだ完成していなのでレポジトリは公開できません. ごめんなさい. それでは見ていきましょう. ちなみにコードのライセンスは特にありません. 世界平和のためなら何に使っていただいても大丈夫です.

Environmentとは?

Lispで(他の言語にあるかは知らないです)識別子の束縛情報を追いかけるための構造です. 詳しくはここでは解説しないのでSICP(もしくは他のもっと適切な書物)を参照してほしいのですが, meta-circular evaluatorで識別子の束縛状態を記録するのに用いられています. 今回Typed Racketで再実装するに当たって, すこし本と違う形で実装することになったのですが, trivialなので問題ないと思います.

はじめの型定義

ではさっそく始めます. まず, EnvironmentはFrameとよばれる構造のListで表されます.

(define-type Environment (Listof Frame))

FrameはBindingとよばれる構造のListで表されます.

(define-type Frame (Listof Binding))

BindingはVariableとValueのcons pairです.

(define-type Binding (Pairof Variable Value))

VariableはSymbol, ValueはとりあえずAnyのsynonymにしておきます.

(define-type Variable Symbol)
(define-type Value Any)

Accessorsと補助関数

次に, これらの構造に対する関数を定義していきます. まずは, Frameへのaccessors, そして空のglobal environmentも定めておきます. the-empty-environmentは本との互換性を考えて残しておきました. 副作用の分離は言語に強制されないのでご自分の責任で...

(: first-frame (-> Environment Frame))
(define (first-frame env) (car env))

(: enclosing-environment (-> Environment Frame))
(define (enclosing-environment env) (cdr env))

(: *environment* : Environment)
(define the-empty-environment '())
(define *enviornment* the-empty-environment)

次にBindingに対するaccessorsを定義します. Code as documentの心持ちでコメントはあんまりないです. 型がドキュメントだ(知らんけど).

(: binding-variable (-> Binding Variable))
(define (binding-variable pair) (car pair))

(: binding-value (-> Binding Value))
(define (binding-value pair) (cdr pair))

次に, 与えられたVariableが与えられたFrame内に束縛を持っているかを調べる関数です.
(Option a)は(U a False)のtype-aliasです.

(: variable-in-frame? : (-> Variable Frame (Option Binding)))
(define (variable-in-frame? var frame) (assoc var frame))

そして, 与えられたVariableとValueをFrameに追加する関数を作ります. これは純粋です.

(: add-binding-to-frame : (-> Variable Value Frame Frame))
(define (add-binding-to-frame var val frame)
  (let ((dup : (Option Binding) (variable-in-frame? var frame)))
    (cons (cons var val) (if dup (remove dup frame) frame))))

global-environmentに対する副作用

add-binding-to-frameを用いて, global-environmentに対して束縛を追加する副作用のある関数を作ります.

(: add-binding-to-global-frame! : (-> Variable Value Void))
(define (add-binding-to-global-frame! var val)
  (let ((new-binding : Binding (cons var val)))
    (if (null? *environment*) (set! *environment* (list (list new-binding)))
      (set! *environment* 
        ((inst cons Frame Environment) 
         (add-binding-to-frame var 
                               val 
                               (first-frame (ann *environment* Environment)))
         (enclosing-environment *environment*))))))

Environment model of evaluation

Environment model of evaluationと呼ばれるLispの式の評価方法では, 関数やlet clauseによる束縛などを評価する時に, lexical-bindingやローカル変数といった仕組みを実現するための方法として"ある一定期間だけある特定のbinding情報を含むFrameを作り, 評価が終了したら廃棄する"という方法をとります. この機能の実現のために, 与えられたVariableとValueのリストから作られたBindingのList, すなわちFrameを一時的にglobal-environmentの先頭に追加し, そのglobal-environment下で目的の式を評価し, 終了時にFrameを取り除くという操作を行います. 下の関数はそのための, 一時的にglobal-environmentを更新するための関数です.

(: extend-environment : (-> (Listof Variable) (Listof Value) Environment 
                            Environment))
(define (extend-environment vars vals base-env)
  (: make-frame : (-> (Listof Variable) (Listof Value) (Option Frame)))
  (define (make-frame vars vals)
    (and (= (length vars) (length vals)) 
         ((inst map Binding Variable Value) 
          (inst cons Variable Value) vars vals)))
  (let ((new-framep : (Option Frame) (make-frame vars vals)))
    (if new-framep (cons new-framep base-env)
      (error "Number of given variables and values don't match: " vars vals))))

ここまできたら大方の機能は実装できました. あとは, 検索関数などを実装すればいいです. これは検索関数です.

(: lookup-variable-value : (-> Variable Environment Value))
(define (lookup-variable-value var env)
  (: env-iter : (-> Environment Value))
  (define (env-iter env)
    (: frame-iter : (-> Frame Value))
    (define (frame-iter frame)
      (let ((maybe-first-val : (Option Binding) (variable-in-frame? var frame)))
        (if maybe-first-val (binding-value maybe-first-val)
          (env-iter (enclosing-environment env)))))
    (if (eq? env the-empty-environment)
      (error "No binding in given environment:") (frame-iter (first-frame env))))
  (env-iter env))

もちろん, global-environmentに対してset!を働かせることも考えないといけません. これがそのための関数です.

(: set-variable-value! : (-> Variable Value Void))
(define (set-variable-value! var val)
  (: env-iter (-> Environment Environment))
  (define (env-iter env)
    (: frame-update : (-> Frame Environment))
    (define (frame-update frame)
      (cond [(variable-in-frame? var frame) 
             (cons (add-binding-to-frame var val frame) (enclosing-environment env))]
            [else (env-iter (enclosing-environment env))]))
    (if (eq? env the-empty-environment) (error "No binding in the current env")
      (frame-update (first-frame env))))
  (set! *environment* (env-iter *environment*)))

最後にdefineがきちんと働くように補助関数を作っておしまいです. といってもこれは本との互換性を保つためのwrapperですが.

(: define-variable! : (-> Variable Value Void))
(define (define-variable! var val)
  (add-binding-to-global-frame! var val))

コード全体

コード全体はこんな感じです.

#lang typed/racket

(require "./types.rkt")
(provide (all-defined-out))

#| Select the first frame of a given environment. |#
(: first-frame (-> Environment Frame))
(define (first-frame env) (car env))

#| Select enclosing frames of a given environment. |#
(: rest-frames (-> Environment Environment))
(define (rest-frames env) (cdr env))

#| Select enclosing environment of a given environment. |#
(: enclosing-environment : (-> Environment Environment))
(define (enclosing-environment env) (cdr env))

(define the-empty-environment '())
(: *environment* : Environment)
(define *environment* the-empty-environment)

#| Define selectors of a frame, |#
(: binding-variable (-> Binding Variable))
(define (binding-variable pair) (car pair))

(: binding-value (-> Binding Value))
(define (binding-value pair) (cdr pair))

#| Returns all the variables in a given frame. |#
(: frame-variables : (-> Frame (Listof Variable)))
(define (frame-variables frame) 
  ((inst map Variable Binding) car frame))

#| Returns all the values in a given frame. |#
(: frame-values : (-> Frame (Listof Value)))
(define (frame-values frame)
  ((inst map Value Binding) cdr frame))

#| If given variable exists in a given frame, 
   return the binding. Otherwise returns false. |#
(: variable-in-frame? : (-> Variable Frame (Option Binding)))
(define (variable-in-frame? var frame) (assoc var frame))

#| Pure procedure that returns newly crated frame whose members
   are updated with Binding. |#
(: add-binding-to-frame : (-> Variable Value Frame Frame))
(define (add-binding-to-frame var val frame)
  (let ((dup : (U Binding False) (variable-in-frame? var frame)))
    (cons (cons var val) (if dup (remove dup frame) frame))))

#| Add given mapping of (ann (cons var val) Binding) onto global environment 
   *environment*.|#
(: add-binding-to-global-frame! : (-> Variable Value Void))
(define (add-binding-to-global-frame! var val)
  (let ((new-binding : Binding (cons var val)))
    (if (null? *environment*) (set! *environment* (list (list new-binding)))
      (set! *environment* 
        ((inst cons Frame Environment) 
         (add-binding-to-frame var 
                               val 
                               (first-frame (ann *environment* Environment)))
         (rest-frames *environment*))))))

#| Temporarily extend the environment with corresponding variables and
values given. As this is a pure function, after an evaluation of any expr
under newly created environment, the created environment is simply discarded.
Imitating the environment-model of evaluation process. |#

(: extend-environment : (-> (Listof Variable) (Listof Value) Environment 
                            Environment))
(define (extend-environment vars vals base-env)
  (: make-frame : (-> (Listof Variable) (Listof Value) (Option Frame)))
  (define (make-frame vars vals)
    (and (= (length vars) (length vals)) 
         ((inst map Binding Variable Value) 
          (inst cons Variable Value) vars vals)))
  (let ((new-framep : (Option Frame) (make-frame vars vals)))
    (if new-framep (cons new-framep base-env)
      (error "Number of given variables and values don't match: " vars vals))))

#| Returns the first occurrence of a given variable unde given environment. |#
(: lookup-variable-value : (-> Variable Environment Value))
(define (lookup-variable-value var env)
  (: env-iter : (-> Environment Value))
  (define (env-iter env)
    (: frame-iter : (-> Frame Value))
    (define (frame-iter frame)
      (let ((maybe-first-val : (U Binding False) (variable-in-frame? var frame)))
        (if maybe-first-val (binding-value maybe-first-val)
          (env-iter (enclosing-environment env)))))
    (if (eq? env the-empty-environment)
      (error "No binding in given environment:") (frame-iter (first-frame env))))
  (env-iter env))

#| Set a value of a variable to a given value in a frame where
   var first occurs in the global *environment* |#
(: set-variable-value! : (-> Variable Value Void))
(define (set-variable-value! var val)
  (: env-iter (-> Environment Environment))
  (define (env-iter env)
    (: frame-update : (-> Frame Environment))
    (define (frame-update frame)
      (cond [(variable-in-frame? var frame) 
             (cons (add-binding-to-frame var val frame) (rest-frames env))]
            [else (env-iter (enclosing-environment env))]))
    (if (eq? env the-empty-environment) (error "No binding in the current env")
      (frame-update (first-frame env))))
  (set! *environment* (env-iter *environment*)))

#| Wrapper of add-binding-to-glbal-frame|#
(: define-variable! : (-> Variable Value Void))
(define (define-variable! var val)
  (add-binding-to-global-frame! var val))

おしまいです

これ動くんですよ. ホントです. ありがとうございました.

ちょっぴり追記

これはmeta-circular evaluator全体のほんの一部ですが, Typed-Racketを使った実装をもう少しだけお見せします. 例えば, defineを用いた式を解析する時にはこんな感じのコードを書きます.

#lang typed/racket

(require "./types.rkt")
;;; types.rktにはEnvironmentの型定義やExprの型定義が含まれている.
;;; where (define-type Expr 
;;;         (Rec Expr (U Symbol Number String Null (Pairof Expr Expr)))
(provide (all-defined-out))

(define-type DefinitionExpr 
             (U (List 'define Variable Expr) 
                (List 'define (List* Variable Variable) Expr)))

(define-syntax (definition? stx)
  (syntax-case stx ()
    [(_ expr) #'((make-predicate DefinitionExpr) expr)]))

(: definition-variable : (-> DefinitionExpr Variable))
(define (definition-variable expr)
  (let ((part : (U Variable (List* Variable Variable)) (cadr expr)))
    (if (symbol? part) part (car part))))

(: definition-value : (-> DefinitionExpr Expr))
(define (definition-value expr) (caddr expr))

DefinitionExprでdefineを用いた式の形の全てを定めています. Typed-Racketの型システムはLispの為に作られただけあって, このようにある特定のS式の形に合致するような型を定めたりすることが出来ます. make-predicateでpredicateを一発生成できたりと便利です. Structを使うとどうなるんでしょうね. 私もまだ使い始めて日が浅いので, 便利機能があれば教えていただきたいです. おしまい.