5年ぶりの歯医者に行きました

歯医者に行きました。最後に行ったのは4,5年前に下の親知らずを抜くために行ったのだったはず。久しぶりに行こうと思ったのは、下の歯が染みて痛くなっていたのと、歯が腐ってツラかったみたいな話を聞いたからです。

東五反田の佐藤歯科医院というところを予約して行きました。

結論から書くと

  • 虫歯は8個あるがどれも表面にとどまったものでそこまで悪化していない。虫歯が神経に到達するまで痛みは出ないはずなので歯が滲みる原因は虫歯ではない。

  • 歯ぎしりと歯の噛みしめをする癖があることを指摘された。これは自覚があったので納得できた。歯ぎしりと噛み締めにより歯の神経が脳震盪のような状態になり歯が沁みるのだと結論付けられた。歯ぎしりをやめろということと、寝る際に歯ぎしりをしないようにマウスピースを作ることになった。

  • 上の方の親知らずが磨けていないので抜いたほうが良い

  • 頬杖をつくと死ぬぞ、とアドバイスをされたが「うるさい!俺は死ぬんだ!」と言いたくなるのを我慢した

ということでした。診療自体はレントゲンを撮ったりマウスピースの型を取ったり僕の質問応答で終わりました。ちなみにマウスピースは3000円くらいで作れるみたいでした。

夜寝る際の噛みしめ、歯ぎしりはマウスピースで解決するとして、日中の歯ぎしりは気をつける他ないそうでした。ここ数年は人生が苦悩に満ちているので歯ぎしりが習慣化してしまいました。歯同士が当たっている状態は歯に負担なので食事のとき以外は歯を当てないのが普通らしいです。僕は常に歯を食いしばって生きているので常にあたっている状態でした。普通の人間は歯を噛み締めないんですね。舌を歯の裏に押し付けると歯同士が当たらないことに気がついたのでこうして生きていこうと思います。

10日後くらいにまた予約したので行ってきます。

院長は受け答えが明白なので信用してもよいのではないかと思いましたが自分でも少し歯について調べてみようかなと思います、余裕があれば。歯に関して一家言ありそうなタイプでした。

3impの3章 The Heap-Based Modelを読み終えた

3imp https://www.cs.unm.edu/~williams/cs491/three-imp.pdf のHeapベースの実装を見ました。なんか手を動かしたくなったので、Haskellで書き直してみました。https://gitlab.com/saitouena/3imp-hs sicpの5.5の翻訳系の話 https://sicp.iijlab.net/fulltext/x550.html のところの復習みたいなところが大きかったのですが、勉強になったところがいくつかありました。

継続の実装

vmでどのように継続を扱うかが理解できました。

-- (define (vm a x e r s) ...)
 -- x is next instruction
vm :: LispVal -> VMInsn -> Env -> Rib -> VMStack -> State VMStore LispVal

vmの型です。aが結果を入れるレジスタ、xは次に実行する命令、eは環境、rは評価した引数を貯めていくところ、sがコールフレームで、実行文脈そのものです。

data VMStack = EmptyStack
             | CallFrame VMInsn Env Rib VMStack -- vmInsn = return address (executed after return)
  deriving (Show, Eq)

これを見ると、VMStackは(次の命令、環境、引数、前のコールフレーム)になっていて、これがあれば関数呼び出しからもとの評価文脈に戻って実行が再開できるようになっています。これは継続そのもののようなものですね、ということで継続オブジェクトの定義は以下のようになっています。継続はクロージャーとして実装されています。

makeContinuation :: VMStack -> LispVal
makeContinuation s = Closure ["v"] (Nuate s "v") emptyEnv

emptyEnvのところはsから取り出された環境で上書きされ、実質無視されるので何でも良いです。Nuate s "v" というのは継続を呼び出すためのvm命令です。ちょっとこの部分がわかりづらいので見てみましょう。継続を作る命令 Contiと継続を呼び出す命令Nuateがペアになっています。

data VMInsn = Halt -- (halt)
...
            | Conti VMInsn -- (conti x)
            | Nuate VMStack VarName -- (nuate s var)
...

-- compiler
compile (List ((Atom "call/cc"):[x])) next = let c = Conti $ Argument $ compile x Apply -- x は (lambda (k) ...)の形
                                             in if isTail next
                                                then c
                                                else Frame next c

-- vm
vm a (Conti x) e r s = vm (makeContinuation s) x e r s
vm a (Nuate s var) e r _ = do -- NOTE: passed stack is not used
  val <- getVal var e
  vm val Return e r s

これを踏まえて、実際に (call/cc (lambda (k) ...がどのようにコンパイルされるのかを見ましょう。

    it "(call/cc (lambda (c) (0 (c 1))))" $ do
      (runCompileTail "(call/cc (lambda (c) (0 (c 1))))") `shouldBe` (Conti
                                                                       (Argument
                                                                         (Close
                                                                           ["c"]
                                                                           (Frame
                                                                             (Argument
                                                                              (Constant
                                                                               (Number 0)
                                                                                (Apply)))
                                                                             (Constant
                                                                               (Number 1)
                                                                               (Argument
                                                                                (Refer
                                                                                 "c" -- 1. cは Closure ["v"] (Nuate s "v") emptyEnv の形になっているはず
                                                                                 Apply))))
                                                                           Apply)))

で、このvは(c 1) と引数に指定された1に束縛された状態で、cがapplyされます。継続をクロージャーとして実装しているため、継続に返す値を受け渡すためにこのような仕組みになっている、ということだと思います。よく考えないと理解できないのでここが一番難しいと思いました。Nuateがcompilerに陽に出てこないのが難しさの原因な気もします。継続は実行時じゃないと作れないので仕方ない気がしますが。このvmは特殊な言語機能に依存していないので、どの言語でも移植できそうな感じがするのでいいなと思いました。ここまでの実装にheap_vmのタグを打ってあるので見てみたい人がいればどうぞ。

変数アクセスの最適化

3.5 Improving Variable Accessのところは、sicpの文面アドレス https://sicp.iijlab.net/fulltext/x556.html のところに対応しているので、そっちで理解している人は読む必要がなさそうです。コンパイル時環境を持つと、実行時には変数名を持つ必要がなくなりますよ、という話です。文字列比較のオーバーヘッドがなくなって嬉しい。compile_time_environmentのタグを打ってあります。

haskellで書き直すときに考えること

schemeはデータを破壊的に変更することができるので、3impのコードではset!をつかってset!が実装されているのですが、これはHaskellに治すには工夫する必要があります。私は、実際にschemeの値を入れる Store :: Vector LispVal と、変数とStoreのインデックスを紐付けるものとしてEnv :: [(VarName,Int)] として用意して、vmの型を State Store LispVal にして副作用をエミュレートしました。表示的意味論もこういう作戦を取っているのでそれを真似しました。なんでStoreとEnvを分けてるんだ...? と疑問に思っていたのですが、純粋な関数として書こうとするとそうなってしまうということが理解できたと思います。ただはじめにあるVectorのサイズを超える変数が来るとabortしてしまうのですが...いつかちゃんとメモリ管理を実装したいと思ってできていないことを思い出さされ憂鬱になりました。

4章もHaskellに直しつつ読んでいってみようと思います。

継続クイズ4問(解説付き)

継続クイズです。4問といいつつ、自分で考えたのは最後(4)のやつだけで、それ以外は3impの2.4からの引用ですね...。

;; (1)
(let ([comeback (call/cc (lambda (c) c))])
  (comeback comeback))

;; (2)
(let ([comeback (call/cc (lambda (c) c))])
  (comeback 3))

;; (3)
(let ([comeback (call/cc (lambda (c) c))])
  (comeback (lambda (x) x)))

;; (4)
(define comeback (call/cc (lambda (c) c)))
(comeback comeback)

それぞれ、結果はどうなるでしょうか。最後のは処理系依存だと思うので、「こういう仮定をすれば、こうなる」という回答の仕方になると思います。gaucheだと、トップレベルでの(internal defineでない、という意味で使っています)(define x v)は、「vをxに束縛し、シンボルxを返す」という挙動になっています。

(1)

答え: 無限ループします。ステップバイステップで評価していってみます。継続がキャプチャされるところの内側を{}で囲んでみます。キャプチャされた継続をkとすると、(k v)のように呼び出された継続は、{}で囲まれた部分をvで置き換えた上で、{}でキャプチャされた部分の外側へ制御が戻ります。日本語で説明するのは難しいので、書き換えながら理解してみます。

(let ([comeback {(call/cc (lambda (c) c))}]) ;; [1] ここで捉えられた継続をkとする。kはcomebackに束縛される。
  (comeback comeback))
;; =>
(comeback comeback)
;; =>
(k k) ;; [2] 継続の呼び出し。
;; =>
(let ([comeback k]) ;; [3] [1]の{}の部分を継続kの呼び出しのときに渡されたkで置き換えた. comebackはkに束縛される。
  (comeback comeback))
;; =>
(k k) ;; [2'] [2]にまた戻ったので、無限ループしていることがわかる。

(2)

(3 3)が評価され、実行時エラー。流れを追ってみます。

(let ([comeback {(call/cc (lambda (c) c))}]) ;; [1] ここで捉えられた継続をkとする。kはcomebackに束縛される。
  (comeback 3))
;; =>
(comeback 3)
;; =>
(k 3) ;; [2]継続の呼び出し。
;; =>
(let ([comeback 3]) ;; [3] [1]の{}を継続kの呼び出しのときに渡された3で置き換えた
  (comeback 3))
;; =>
(3 3) ;; error

(3)

(lambda (x) x)を評価した結果のclojureが返ります。

(let ([comeback {(call/cc (lambda (c) c))}]) ;; ;; [1] ここで捉えられた継続をkとする。kはcomebackに束縛される。
  (comeback (lambda (x) x)))
;; =>
(k (lambda (x) x)) ;; [2]継続の呼び出し。(書くのが面倒なので、ここで(lambda (x) x)は(lambda (x) x)を評価した結果のclojureを表すのに使っている。)
;; =>
(let ([comeback (lambda (x) x)])
  (comeback (lambda (x) x))) ;; [3] [1]の{}を継続kの呼び出しのときに渡された(lambda (x) x)で置き換えただけ
;; =>
((lambda (x) x) (lambda (x) x))
;; =>
(lambda (x) x)

(4)

gaucheの場合を追ってみます。

(define comeback {(call/cc (lambda (c) c))}) ;;[1]継続のキャプチャ。キャプチャされた継続をkとする。より詳しく説明すると、kは「前の継続から渡された値をcomebackに束縛し、シンボルcomebackを返し、replのトップに戻りプロンプトを表示する」という継続になっています。
;; => comeback
(comeback comeback)
;; =>
(k k) ;; [2]継続の呼び出し。
;; =>
(define comeback k) ;; [3] [1]の{}を渡されたkで置き換えた。
;; => comeback
comeback
;; => #<subr "continuation">

何問正解できましたか?私はなんとなく(1)が無限ループするなら(4)も無限ループだろ、みたいに雑に考えていた(replに打ち込んだら違って驚いた)ので、継続がわかっていなかったみたいです。call/ccの呼び出しを{}(紙面でやるときは四角で囲んでやっています)で囲う、その継続が呼び出されたら、{}を呼び出しに渡された値で置き換えて評価を継続、というやり方で考えると機械的に解けそうな気がしてきましたが、複雑な環境とか副作用が絡んでくると難しくなってくるかもしれません。ここのクイズではあまり意識する必要はありませんでしたが、キャプチャされた継続は環境も束縛します。クロージャの型がValue* -> Environment -> Store -> Valueなのに対して(Storeはメモリセルの状態)、継続の型はValue* -> Store -> Valueである、ということです。set!とかを使って超難しい継続クイズが作れそうな気がしているので、なにかいいのが思いつく or 資料で発見する、などがあったら紹介するかもしれません。

techacademyがteratailの質問を転載して記事を作っている

きっかけとなったのが以下のツイート。去年のツイートではあるがリツイートで回ってきた。

少し気になったため、ツイッターで検索してみたところ、2月末の以下の内容のツイートを発見した。

このツイートの、techacademyの元記事は削除済みである。(web archiveでは、「お探しの記事は見つかりません」のスナップショットしかなかった。)

以下のページの、初めのページのリストの分だけ、google検索を利用して検証してみた。

techacademy.jp

以下のリンクは、そのメモである。

pastebin.com

google searchというのが、検証に利用したクエリの結果であり、techacademyとあるのが転載の記事へのリンク、teratailとあるのが転載元の質問である。

質問内容の転載であるものから、回答まで転載(盗用というべきなのか?)されているものまで、さまざまである。

気になったこと

以下の記事に登場するような、mentor-takedaなる人物は実在するのだろうか。

techacademy.jp

mentor-takedaのプロフィールを記事から引用する。

mentor-takeda

関数型プログラミング言語(HaskellやLispなど)を使用した数値計算システム開発業務に長年従事。

そのほかにも「太田和樹」「吉本 敏洋」なる人物が登場する。実在しない人物の場合のみ転載なのか、とも疑ったがそうでもないらしい。以下のリンクは質問のみ転載のパターンであったが、techacademyでの回答者は実際のtechacademyのメンターであるようだ。

techacademy.jp

teratail.com

すべての記事を検証するほどの体力がないため、ここで終わりにしようと思う。アウトソーシングした記事が既存の記事の転用だった、というような話も聞いたことがあるが、結局運営の責任であることには変わらない。短時間でやったため、もしかしたらtechacademyが先に上げている記事もあるかもしれない。余力があれば、この件についてそのうちtechacademyに問い合わせるかもしれない。記事とは関係ないが、twitter cardの埋め込みがうまくいかないのはなぜだろうか。

グラフの到達可能性の判定クエリがたくさん来るとき(2パターン)

詰まったのでまとめておきます。導入として以下の問題を考えます。

簡単なほう

有向グラフGと、あるノードxが与えられます。そのうえでクエリがたくさん来ます。クエリの内容は「yを与えます。ノードxからノードyへ到達可能か判定してください」というものです。このクエリに各クエリ当たり定数時間で回答してください

この問題にこたえるには、xから到達可能なノードを前計算しておけばokです。到達可能なノード自体は、xからDFSを行うことで求められます。

詰まったほう

上の問題を少し改変した以下の問題を考えます。

有向グラフGと、あるノードxが与えられます。そのうえでクエリがたくさん来ます。クエリの内容は「yを与えます。ノードyからノードxへ到達可能か判定してください」というものです。このクエリに各クエリ当たり定数時間で回答してください

問題文の変更点は、各クエリのyに対して、前の問題ではx->yの到達可能性を判定していたのに対し、今の問題ではその逆y->xへの到達可能性を判定する問題になっています。クエリ当たり定数時間で回答したいのでいちいちyからDFSするとダメです。この問題にこたえるには、Gの有向辺を逆にする操作reverseを行い、reverse(G)について、x->yへの到達可能性を前計算しておけばよいです。「Gにおいてx->yへ到達可能」<=>「reverse(G)においてy->xへ到達可能」が成立しているからです。

元ネタ と、参考までに、私のプログラムです。

schemeのset!の実装方法

私が考えたわけではなく、広く使われているテクニックのようだ。以下の資料の3.12に書かれている。

http://scheme2006.cs.uchicago.edu/11-ghuloum.pdf

x86アセンブリなどに変換されるコンパイラを想定している。仮想マシン型のインタプリタにも利用されるテクニックのようだが、そちらは私はよくわからない。

前提条件

  • クロージャーの実装はある。ただし、その実装はラムダ式に現れる自由変数をヒープにコピーするものとなっている。
  • vector, vector-ref, vector-set! などのヒープアロケートされるオブジェクトの正しい実装がある。boxなどでも良い。その場合は, box, box-ref, box-set!などとなるだろう。
  • 変数を導入できるのはlambda, letのみ。

実装方法

以下の変換を行うことで変数をエミュレートすることができる。

;; this program is ...
(let ((f (lambda (c)
       (cons (lambda (v) (set! c v))
         (lambda () c)))))
  (let ((p (f 0)))
    ((car p) 12)
    ((cdr p))))

;; transformed to ???
(let ((f (vector (lambda (c)
            (cons (lambda (v) (vector-set! c 0 (vector-ref v 0)))
              (lambda () (vector-ref c 0)))))))
       (let ((p (vector ((vector-ref f 0) (vector 0)))))
     ((car (vector-ref p 0)) (vector 12))
     ((cdr (vector-ref p 0)))))

変数が導入されるのはlambda, letのみであるから、そこで導入された変数をすべてベクターで包んでやるとうまく行く。

(set! x c)
=> (vector-set! x 0 c)

(f x y z) ;; apply
=> (f (vector x) (vector y) (vector z))

(let ((x a)
      (y b))
     ...)
=>
(let ((x (vector a))
      (y (vector b)))
      ...)

(+ x y) ;; 変数の参照
=> (+ (vector-ref x 0) (vector-ref y 0))

あまりよく見ていないのだが、Gaucheでも同様の変換を行っているようだ。

Gauche/box.c at 12b71a83c6e18481e31c83d35ed42c191eb7683f · shirok/Gauche · GitHub

個人的に感動したテクニックなのでココに記しておく。参考までに私の実装例を挙げておく。

set! (6c1c503f) · Commits · t / scm-incr · GitLab

schemeの末尾再帰最適化の仕様と実装

いろいろ勘違いしていたので実装ついでにまとめる. https://sicp.iijlab.net/fulltext/x542.html これを参考にしてやろうとしたらうまく行かなかった。マシンモデルが違うからなのだろうか...

仕様

仕様については、R5RSを見るべし. 「3.5. 真正な末尾再帰」を見ると良い。

http://www.unixuser.org/~euske/doc/r5rs-ja/r5rs-ja.pdf

実装するにあたっての自分なりの理解を記しておこう。R5RSには

末尾呼出し (tail call) とは,末尾文脈 (tail context) に出現
している手続き呼出しである。末尾文脈は帰納的に定義され
る。

とある。帰納的に定義されているからには、まずはベースとなるケースに注目して理解する。

ベースケース

下記に <末尾式> として示されているλ式本体内の最後
の式は末尾文脈に出現している。
(lambda <仮引数部>
<定義>* <式>* <末尾式>)

(lambda ...) がベースケースとなっているので、実装の際はココをベースにして、末尾文脈としての情報を伝搬させていけばよいだろう。

帰納

主なケースを抜粋する。まだサポートしていない特殊形式もあるので。

もし以下の式の一つが末尾文脈にあるならば,<末尾式>
として示されている部分式は末尾文脈にある。

(if <式> <末尾式> <末尾式>)
(if <式> <末尾式>)
(let* (<束縛仕様>*) <末尾本体>)
(begin <末尾列>)
<末尾列> −→ <式>* <末尾式>

つまり、

  • (lambda ... body) の末尾式での関数呼び出しは末尾文脈としてのコンパイルを行う。
  • (lambda ... body) の末尾式が if, let*, begin だった場合は、その末尾式は末尾文脈にあるので末尾文脈としてのコンパイルを行う。また、さらにその末尾式がif, let*, begin なら再帰的に末尾文脈としてのコンパイルを行う。

ということだ(という理解をしている)

実装

まずは末尾文脈の扱いから見ていく

(define (compile-label lexpr label-env)
  (let ((formals (code-formals lexpr))
    (free-vars (code-free-vars lexpr))
    (body (code-body lexpr))) ;; (length vars) = 3 => init-sp = -8 - 8 * 3
    (compile-sequence-tco ;; changed
     body
     (prepare-env formals init-sp)
     (- init-sp (* wordsize (length formals)))
     label-env
     (prepare-free-vars-env free-vars wordsize))
    (ret)))

lambdaのコンパイルに対応しているのがココ。compile-sequence-tcoをするようにしている。

(define (compile-sequence-tco seq var-env si label-env free-vars-env)
  (if (null? (cdr seq))
      (compile-expr-tco (car seq) var-env si label-env free-vars-env)
      (begin
    (compile-expr (car seq) var-env si label-env free-vars-env)
    (compile-sequence (cdr seq) var-env si label-env free-vars-env))))

末尾文脈としてのコンパイルは、compile-expr-tco が行う。

;; for tailcall optimization
(define (compile-expr-tco expr var-env si label-env free-vars-env)
  (cond ((let*? expr)
     (compile-let*-tco (let-bindings expr) (let-body expr) var-env si label-env free-vars-env))
    ((if? expr)
     (compile-if-tco (if-test expr) (if-conseq expr) (if-altern expr) var-env si label-env free-vars-env))
    ((begin? expr)
     (compile-sequence-tco (begin-seq expr) var-env si label-env free-vars-env))
        ...
    (else ;; apply
     (compile-funcall-tco (apply-op expr) (apply-args expr) var-env si label-env free-vars-env))))

それぞれ末尾文脈としてのコンパイル再帰的に行っている。肝心の末尾呼び出しを最適化しているところを見る。比較のため、末尾呼び出しでないパターンの関数呼び出しも載せておく

(define (compile-funcall op args var-env si label-env free-vars-env)
  (let ((args-base (- si wordsize wordsize)) ;; There is two rooms(the one for current closure pointer(rsi), the another for stack pointer(rsp)).
    (rsp-base (+ si wordsize)))
    (compile-args args var-env args-base label-env free-vars-env)
    (compile-expr op var-env si label-env free-vars-env) ;; compile closure
    (emit "sub rax, ~a" #b110)
    (emit "lea rsp, [rsp+(~a)]" rsp-base)
    (emit "push rsi")
    (emit "mov rsi, rax") ;; set closure pointer
    (emit "mov rax, [rax]")
    (emit "call rax")
    (emit "pop rdi")
    (emit "lea rsp, [rsp-(~a)]" rsp-base)))

;; tail call optimized version
(define (compile-funcall-tco op args var-env si label-env free-vars-env)
  (let ((init-si si) (numargs (length args)))
    (let loop ((args args) (si si))
      (if (not (null? args))
      (begin
        (compile-expr (car args) var-env si label-env free-vars-env)
        (emit "mov [rsp+(~a)], rax" si)
        (loop (cdr args) (- si wordsize)))
      (begin
        (compile-expr op var-env si label-env free-vars-env)
        (emit "sub rax, ~a" #b110)
        (emit "mov rsi, rax") ;; set closure pointer
        (emit "mov rax, [rax]") ;; set rax to point closure procedure label
        (let loop ((cnt numargs) (arg-offset init-si) (copyto (- wordsize)))
          (if (= cnt 0)
          (emit "jmp rax") ;; jmp to label
          (begin
            (emit "mov rbx, [rsp+(~a)]" arg-offset)
            (emit "mov [rsp+(~a)], rbx" copyto)
            (loop (- cnt 1) (- arg-offset wordsize) (- copyto wordsize))))))))))

末尾呼び出しの際に、クロージャポインターrsi(クロージャーを指すアドレスが入っている。自由変数の参照はこのポインタを介して行われる)の待避を行わず、rsiに呼び出す手続きを指すクロージャーをセットしている。引数を[rsp-8], [rsp-16], ... にコピーし、そのままjmpしている。これをみると、C ABIとは違って、リターンアドレス -> 引数の順にスタックに積んでいたことの嬉しさが見えてくる。C ABIだと、引数が3個の手続きから引数が4個の手続きを呼んだ場合に、末尾呼び出しの最適化での引数のコピーを行うスペースがなくなってしまうからだ。引数側の方にスタックが伸びるスペースがある、ということが重要なわけだ。

アセンブラの比較

((lambda (x) ;; even? form SICP 4.21 b
  ((lambda (even? odd?)
     (even? even? odd? x))
   (lambda (ev? od? n)
     (if (= n 0) #t (od? ev? od? (- n 1))))
   (lambda (ev? od? n)
     (if (= n 0) #f (ev? ev? od? (- n 1))))))
10)

コンパイル結果を比較する。

Saved diff ix3ee7QA - Diff Checker

callがjmpに置き換わっているのがわかる。

勘違いしていたこと

(begin ...)(let (...) ...) の末尾は必ず末尾呼び出しにするという雑な理解だったため、以下のようなケースでバグっていた。

(let* ((x 1) (y 2) (g (lambda (x) (+ x y))))
                 (begin
                   (g 10)
                   (g 3))
                 (begin
                   1
                   (g y)))

(g 3) の呼び出しが最適化されるためスタックが壊れておかしくなっていた.

コード

はこれ

https://gitlab.com/saitouena/scm-incr/commit/18c69f7602ed200bbed5f335bf54a7a8b50b9eb1