TweetDeckを読み上げるやつ・改

だいぶ前にTweetDeckのタイムラインを読み上げるブックマークレットの記事を書きましたが、

roodni.hatenablog.com

使ってみると

  • ホームタイムラインが複数あると同時に読み上げられて理解が追いつかない
  • 読み上げに時間のかかるツイートがある(例: 同じアルファベットの繰り返し)

など問題点がいくつかあったのでさらに改造しました。

このコードをコピペしてブックマークに登録すると使えます。デスクトップのGoogle ChromeFirefoxで動作確認済みです。 使い方は前回と同じで、TweetDeckのタブで実行すると読み上げが開始され、再度実行すると読み上げが中止されます。

圧縮していないソースコード(折り畳み)

(()=>{
  const stateKey = Symbol.for("read");

  if (window[stateKey] === undefined) {
    const createUttr = (name, text) => {
      const pitchTableKey = Symbol.for("pitch");
      if (window[pitchTableKey] === undefined) {
        window[pitchTableKey] = new Map();
      }
      const pitchTable = window[pitchTableKey];
      let pitch = pitchTable.get(name);
      if (pitch === undefined) {
        pitch = Math.random() * 0.4 + 0.8;
        pitchTable.set(name, pitch);
      }
      // console.log("name = %s, pitch = %f", name, pitch);
      const uttr = new SpeechSynthesisUtterance(text);
      uttr.pitch = pitch;
      uttr.lang = "ja-JP";
      return uttr;
    };

    const queue = [];
    const queueMax = 10;
    let timeout = false;
    const speakNext = () => {
      if (queue.length === 0) {
        // console.log("queue is empty");
        return;
      }
      if (queue.length > queueMax) {
        // console.log("queue overflow");
        queue.length = 0;
        speechSynthesis.cancel();
        return;
      }
      const uttr = queue.pop();
      const timer = setTimeout(() => {
        // console.log("timeout");
        timeout = true;
        if (queue.length >= 1) {
          speechSynthesis.cancel();
        }
      }, 5000);
      uttr.addEventListener("end", () => {
        // console.log("end: ", uttr.text);
        clearTimeout(timer);
        speakNext();
      });
      timeout = false;
      speechSynthesis.speak(uttr);
    }

    const extractText = node => {
      const tweetElement = node.firstElementChild.firstElementChild;
      const name = tweetElement.getElementsByClassName("fullname")[0].textContent;
      const text = tweetElement.getElementsByClassName("js-tweet-text")[0].textContent;
      return {name, text};
    };
    const target = document.getElementsByClassName("js-chirp-container");
    const isHomeTimeline = container => container.parentNode.parentNode.previousElementSibling.textContent.trim().substr(0, 4) === "Home";
    const columns = [...target].filter(isHomeTimeline);

    if (columns.length >= 1) {
      const columnNames = columns.map((c, i) =>
        `${i}: ${c.parentNode.parentNode.previousElementSibling.textContent.trim()}`
      );
      const input = (columns.length === 1) ? 0 : prompt(`タイムラインを選択してください\n${columnNames.join("\n")}`, 0);
      const column = columns[parseInt(input)] || columns[0];
      const observer = new MutationObserver(mutations => {
        for (mutation of mutations) {
          Array.from(mutation.addedNodes).reverse().forEach(tweetNode => {
            const {name, text} = extractText(tweetNode);
            // console.log(`text: "${text}"`);
            if (text !== "") {
              const uttr = createUttr(name, text);
              queue.unshift(uttr);
              if (!speechSynthesis.speaking) {
                speakNext();
              } else if (timeout) {
                speechSynthesis.cancel();
              }
            }
          });
        }
      });
      observer.observe(column, {childList: true});
      window[stateKey] = {
        observers: [observer],
        queue: queue
      };
      queue.unshift(createUttr("", "読み上げをはじめます"));
      speakNext();
    } else {
      alert("ホームタイムラインが存在しません");
    }
  } else {
    window[stateKey].observers.forEach(observer => { observer.disconnect(); });
    window[stateKey].queue.length = 0;
    window[stateKey] = undefined;
    speechSynthesis.cancel();
    alert("読み上げを中止しました");
  }
})()

変更点

  • ホームタイムラインが複数ある場合どれを読み上げるか選択できるようにしました。
  • ツイートの読み上げに5秒以上かかっているときに新しいツイートが来たら中断して新しいツイートを優先するようにしました。
  • タイムラインを下にスクロールすると大量のツイートが読み上げられてしまう問題を改善しました。
  • 声の選択機能を消去しました。
  • Android版のGoogle Chromeに対応しました。

雑記

  • FirefoxではSpeechSynthesisUtterancelang"ja-JP"に設定してあげないと日本語を読んでくれないみたいです。
  • スクリプトをminifyするのにはuglify-esを使いましたが、残念なことにuglify-esはNull合体演算子??に対応していないようです。なおuglify-esの派生元であるuglify-jsはES5専用で、アロー関数式にすら対応してないので雑なブックマークレット制作には使えそうにありませんでした。
  • スマホで使うにはTweetDeckをメインで開き続けている必要があり、使い勝手は非常に悪いです。PWA化すれば便利な読み上げアプリに化けるかもと一瞬考えましたが、このブックマークレットはTweetDeckに依存しているやつなのでやはり難しそうです。

SKK日本語入力を使いはじめた(Mac, JIS配列)

周囲の人が皆SKKを使っているので、私も2週間くらい前から使うようになりました。

はじめに私の環境を述べておきましょう:

Macならbrewで簡単にインストールできます。

brew cask install aquaskk
brew cask install karabiner-elements

Karabiner-ElementsはSandS(シフトキーをスペースバーで代用するやつ)のために使います。SandSなしでSKK入力に手を出そうものなら、程なくして小指が粉砕され再起不能になってしまうでしょう……

さて、インストールのあとSandSの設定をすれば一応SKKを使うことができるようになるんですが、そのままだといくつか問題点があるのでAquaSKKとKarabiner-Elementsの設定をいじって直していきます。

問題点と解決方針

  • ¥キーで「\」を入力したいのに「¥」が入力されてしまう。「\」を入力するためにはoption + ¥を押さないといけない

Karabiner-Elementsで¥とoption + ¥を入れ替えます。

  • ターミナルでC-jを押すと改行されてしまう
  • VSCodeでC-jを押すと行が結合されてしまう

AquaSKKの設定をいじってかなキーで日本語モードに移行できるようにします。さらにKarabiner-ElementsでC-jをかなキーに変換してしまうことで、C-jによる副作用がなくなります。

  • VSCode上のターミナルで英数モードに移行するためLを押すとモード移行と同時に「l」が入力されてしまう
  • 半角英数を入力する方法がSKKのASCIIモードとMacの英字モードで2通りあって混乱する。後者からはC-jでSKKに戻れない

私は前者の問題の根本的な解決策を知りません……
その場しのぎですが、英数キーでSKKのASCIIモードに移行できるようにすることで、余計な文字が入力されることなくモードを移行できるようになります。ついでにMacの英字モードに移行しなくなるので後者の問題を解決できます。

AquaSKKの設定で適当なキー(私はshift + C-jにしました)をASCIIモードへの移行に割り当てて、Karabiner-Elementsで英数キーを先ほど設定したキーに変換するようにします。

  • SandSの影響でスペースバーの押下判定がスペースバーを離すタイミングになるので、一部のゲームで遊べなくなる

IMESKKの場合のみSandSが有効になるように設定すると良いです。さらに英数キー長押しでMacの英字モードに移行するように設定すれば、SandSを無効にしたい場面で簡単にモードを移行できます。

AquaSKKの設定

はじめに/Library/Input\ Methods/AquaSKK.app/Contents/Resources/keymap.conf~/Library/Application\ Support/AquaSKK/にコピーする必要があります。

コピーしたらSKK_JMODESwitchToAsciiに対応する行をそれぞれ次のように書き換えます。

SKK_JMODE   ctrl::j||keycode::0x68
SwitchToAscii   l||ctrl::shift::j

Karabiner-Elementsの設定

¥キーの問題に関しては次のURLから設定をインポートすると良いです↓
karabiner-elements-complex_modifications

それ以外は自分で設定ファイルを書いた方が早そうだったので書きました。

{
  "title": "円滑にskkを使うためのやつ",
  "rules": [
    {
      "description": "SandS (ja限定)",
      "manipulators": [
        {
          "from": {
            "key_code": "spacebar",
            "modifiers": {
              "optional": [
                "any"
              ]
            }
          },
          "to": [
            {
              "key_code": "left_shift"
            }
          ],
          "to_if_alone": [
            {
              "key_code": "spacebar"
            }
          ],
          "type": "basic",
          "conditions": [
            {
              "type": "input_source_if",
              "input_sources": [
                { "language": "ja" }
              ]
            }
          ]
        }
      ]
    },
    {
      "description": "C-jをかなキーに変換",
      "manipulators": [
        {
          "type": "basic",
          "from": {
            "key_code": "j",
            "modifiers": {
              "mandatory": [
                "control"
              ]
            }
          },
          "to": [
            {
              "key_code": "japanese_kana"
            }
          ]
        }
      ]
    },
    {
      "description": "英数キーをCtrl+Shift+Jに変換 長押しで英数 (ja限定)",
      "manipulators": [
        {
          "type": "basic",
          "from": {
            "key_code": "japanese_eisuu",
            "modifiers": {
              "optional": [
                "any"
              ]
            }
          },
          "to": [
            {
              "key_code": "j",
              "modifiers": [
                "control", "shift"
              ],
              "repeat": false
            }
          ],
          "to_if_held_down": [
            {
              "key_code": "japanese_eisuu",
              "repeat": false
            }
          ],
          "conditions": [
            {
              "type": "input_source_if",
              "input_sources": [
                { "language": "ja" }
              ]
            }
          ]
        }
      ]
    }
  ]
}

上のJSON~/.config/karabiner/assets/complex_modifications/に適当な名前で保存することで、Karabiner-ElementsのComplex modificationsから参照することができます。

雑記

SKKを使いはじめてから最初の3日間くらいは苦しみましたが、ひたすらTwitterとかやってると慣れますね。もはや入力に不自由を感じることはなくなりました。すでに元の入力方法を忘れつつあります。

ただ、SKKを初める前より入力速度が向上したかというとそうでもないような気がします。鍛錬が足りないということでしょうか。まあなんにせよ以前の入力方法を忘れかけているので、当分SKKを使い続けることになると思います……

TweetDeckを読み上げるやつ

追記: 改良しました roodni.hatenablog.com

JavaScriptにはWeb Speech APIとかいうものがあって、ブラウザを喋らせることができます。

Web Speech APIを利用してTweetDeckのホームタイムラインを読み上げさせるReadTweetDeckというChrome拡張があるんですが、これを私の趣味にあわせて勝手に改造してブックマークレットにして使っています。

github.com

↑このコードをコピーしてブックマークのURLとして登録すると使えるはずです。TweetDeckのタブで実行すると読み上げが開始され、再度実行すると読み上げを中止します。

圧縮していないソースコード(折り畳み)

(()=>{
const run = () => {
  const stateKey = Symbol.for("read");

  if (window[stateKey] === undefined) {
    const voices = speechSynthesis.getVoices().filter(voice => voice.lang === "ja-JP");
    if (voices.length === 0) {
      alert("声の取得に失敗しました.再度試してください.");
      return;
    }
    const num = prompt(`声を選択してください\n${
      voices.map((v, id) => `${id}: ${v.name}`).join("\n")
    }`, "0");
    if (num === null) { return; }

    const voice = voices[parseInt(num)] || voices[0];

    const createUttr = (name, text) => {
      const pitchTableKey = Symbol.for("pitch");
      if (window[pitchTableKey] === undefined) {
        window[pitchTableKey] = new Map();
      }
      const pitchTable = window[pitchTableKey];
      let pitch = pitchTable.get(name);
      if (pitch === undefined) {
        pitch = Math.random() * 0.4 + 0.8;
        pitchTable.set(name, pitch);
      }
      console.log("name = %s, pitch = %f", name, pitch);

      const uttr = new SpeechSynthesisUtterance(text);
      uttr.pitch = pitch;
      uttr.voice = voice;
      return uttr;
    };

    speechSynthesis.speak(createUttr("", "読み上げをはじめます"));

    const extractText = node => {
      const tweetElement = node.firstElementChild.firstElementChild;
      const name = tweetElement.getElementsByClassName("fullname")[0].textContent;
      const text = tweetElement.getElementsByClassName("js-tweet-text")[0].textContent;
      return {name, text};
    };

    const isHomeTimeline = container => container.parentNode.parentNode.previousElementSibling.textContent.trim().substr(0, 4) === "Home";

    const target = document.getElementsByClassName("js-chirp-container");
    const observers = Array.from(target).filter(isHomeTimeline).map(column => {
      const observer = new MutationObserver(mutations => {
        mutations.forEach(mutation => {
          Array.from(mutation.addedNodes).reverse().forEach(tweetNode => {
            const {name, text} = extractText(tweetNode);
            speechSynthesis.speak(createUttr(name, speechSynthesis.pending ? text.substr(0, 30) : text));
          });
        });
      });
      observer.observe(column, {childList: true});
      return observer;
    });
    window[stateKey] = observers;
  } else {
    window[stateKey].forEach(observer => observer.disconnect());
    window[stateKey] = undefined;
    speechSynthesis.cancel();
    alert("読み上げを中止しました");
  }
};
speechSynthesis.getVoices();
setTimeout(run, 100);
})()

元のChrome拡張との違い

  • 読み上げ速度はデフォルト
    元のChrome拡張はなぜか読み上げ速度が通常の2倍速なんですが、聞き取りが困難なので通常速度に戻しました。

  • ツイート主の名前は読み上げず本文だけ読み上げる
    名前が絵文字や記号だけで構成されている人が結構いて、そういうのは読み上げてもよくわからないので名前自体読み上げるのをやめました。

  • 読み上げの音声エンジンを選択できる
    MacChromeだと"Kyoko"と"Google 日本語"から選べます。ちなみに前者はオフラインでも利用可能で後者はオンライン専用らしいです。

  • 読み上げを中止できる
    Google 日本語を使っているとなぜか声が出ないまま永遠に再生中状態になってそれ以降の読み上げが働かなくなることがあるんですが、そういうときはいったん読み上げを中止すると直ります。

  • 名前によって声のピッチを変える
    この機能は正直微妙で、改善の余地があります。ピッチにあまり極端な値を指定すると聞き取りにくくなるうえに、音声エンジンによって聞き取りやすい範囲が異なるのでやっかいです。

雑記

speechSynthesis.getVoices()で利用可能な声の一覧を取得できるんですが、私の環境だとこのメソッドは1回目の実行ではなぜか空の配列を返します。そこでブックマークレットでは1回ダミーで呼んだあとに100ミリ秒待機して再度呼ぶというアレな実装をしているんですが、それでもたまに失敗するのが難儀です。

Firefoxで動かない」という報告があったので対応しました。どうもブックマークレットスクリプトが値を返すとその値でページコンテンツが書き換えられてしまうようです(setTimeoutの返り値が悪さをしていました)。

プログラミング言語の基礎概念(CoPL)の演習を解くプログラムを書いた

プログラミング言語の基礎概念(CoPL)という本があります。この本は操作的意味論と型システムの入門書なんですが、オンライン演習システムがあるのが特色で、演習問題を解くと正誤を自動でジャッジしてくれます。

導出規則にしたがって式の評価や型付けを行って導出木を書くというのが演習の形式で、問題はなんと160問も用意されています。すごいですね。

ということで演習システムの問題を解くプログラムを書きました。 github.com

以下の導出システムに対応しています。

  • EvalML1〜5 (簡単な式の簡約、局所定義と束縛、関数抽象・適用、リスト、パターンマッチ)
  • EvalRefML3 (参照)
  • EvalContML1,4 (継続、第一級継続)

Githubで「CoPL」で検索すると同じようなことをしている人がたくさん見つかります。はてなブログにも先駆者がいらっしゃるようです。通過儀礼みたいなものでしょうか。 fetburner.hatenablog.com

さて、作ったプログラムが対応していない問題も別に実装するなり人力で導出するなりしてどうにか160問全部解くことができたので、演習問題を解く過程で得られた(多くは非本質な)知見を後続の人に向けて書き留めておきたいと思います。

動機

はじめのうちは人力で解いていたんですが、EvalML3で関数が再帰をはじめたあたりで導出の量が殺人的になってきて、心が折れてやむなくプログラムに解かせることにしたという経緯があります。参考までにEvalML3のとある問題の導出を載せておきましょう:

長いので折り畳み

|- let rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2) in fib 5 evalto 5 by E-LetRec {
  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib 5 evalto 5 by E-AppRec {
    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- 5 evalto 5 by E-Int {};
    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 5 by E-IfF {
      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- n < 3 evalto false by E-Lt {
        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- n evalto 5 by E-Var1 {};
        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- 3 evalto 3 by E-Int {};
        5 less than 3 is false by B-Lt {};
      };
      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- fib (n - 1) + fib (n - 2) evalto 5 by E-Plus {
        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- fib (n - 1) evalto 3 by E-AppRec {
          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
          };
          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- n - 1 evalto 4 by E-Minus {
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- n evalto 5 by E-Var1 {};
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- 1 evalto 1 by E-Int {};
            5 minus 1 is 4 by B-Minus {};
          };
          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 3 by E-IfF {
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- n < 3 evalto false by E-Lt {
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- n evalto 4 by E-Var1 {};
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- 3 evalto 3 by E-Int {};
              4 less than 3 is false by B-Lt {};
            };
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- fib (n - 1) + fib (n - 2) evalto 3 by E-Plus {
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- fib (n - 1) evalto 2 by E-AppRec {
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- n - 1 evalto 3 by E-Minus {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- n evalto 4 by E-Var1 {};
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- 1 evalto 1 by E-Int {};
                  4 minus 1 is 3 by B-Minus {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 2 by E-IfF {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n < 3 evalto false by E-Lt {
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n evalto 3 by E-Var1 {};
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- 3 evalto 3 by E-Int {};
                    3 less than 3 is false by B-Lt {};
                  };
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib (n - 1) + fib (n - 2) evalto 2 by E-Plus {
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib (n - 1) evalto 1 by E-AppRec {
                      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
                      };
                      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n - 1 evalto 2 by E-Minus {
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n evalto 3 by E-Var1 {};
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- 1 evalto 1 by E-Int {};
                        3 minus 1 is 2 by B-Minus {};
                      };
                      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 1 by E-IfT {
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- n < 3 evalto true by E-Lt {
                          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- n evalto 2 by E-Var1 {};
                          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- 3 evalto 3 by E-Int {};
                          2 less than 3 is true by B-Lt {};
                        };
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- 1 evalto 1 by E-Int {};
                      };
                    };
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib (n - 2) evalto 1 by E-AppRec {
                      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
                      };
                      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n - 2 evalto 1 by E-Minus {
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n evalto 3 by E-Var1 {};
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- 2 evalto 2 by E-Int {};
                        3 minus 2 is 1 by B-Minus {};
                      };
                      fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 1 by E-IfT {
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- n < 3 evalto true by E-Lt {
                          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- n evalto 1 by E-Var1 {};
                          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- 3 evalto 3 by E-Int {};
                          1 less than 3 is true by B-Lt {};
                        };
                        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- 1 evalto 1 by E-Int {};
                      };
                    };
                    1 plus 1 is 2 by B-Plus {};
                  };
                };
              };
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- fib (n - 2) evalto 1 by E-AppRec {
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- n - 2 evalto 2 by E-Minus {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- n evalto 4 by E-Var1 {};
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 4 |- 2 evalto 2 by E-Int {};
                  4 minus 2 is 2 by B-Minus {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 1 by E-IfT {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- n < 3 evalto true by E-Lt {
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- n evalto 2 by E-Var1 {};
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- 3 evalto 3 by E-Int {};
                    2 less than 3 is true by B-Lt {};
                  };
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- 1 evalto 1 by E-Int {};
                };
              };
              2 plus 1 is 3 by B-Plus {};
            };
          };
        };
        fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- fib (n - 2) evalto 2 by E-AppRec {
          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
          };
          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- n - 2 evalto 3 by E-Minus {
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- n evalto 5 by E-Var1 {};
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 5 |- 2 evalto 2 by E-Int {};
            5 minus 2 is 3 by B-Minus {};
          };
          fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 2 by E-IfF {
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n < 3 evalto false by E-Lt {
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n evalto 3 by E-Var1 {};
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- 3 evalto 3 by E-Int {};
              3 less than 3 is false by B-Lt {};
            };
            fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib (n - 1) + fib (n - 2) evalto 2 by E-Plus {
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib (n - 1) evalto 1 by E-AppRec {
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n - 1 evalto 2 by E-Minus {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n evalto 3 by E-Var1 {};
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- 1 evalto 1 by E-Int {};
                  3 minus 1 is 2 by B-Minus {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 1 by E-IfT {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- n < 3 evalto true by E-Lt {
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- n evalto 2 by E-Var1 {};
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- 3 evalto 3 by E-Int {};
                    2 less than 3 is true by B-Lt {};
                  };
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 2 |- 1 evalto 1 by E-Int {};
                };
              };
              fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib (n - 2) evalto 1 by E-AppRec {
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var2 {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] |- fib evalto ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)] by E-Var1 {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n - 2 evalto 1 by E-Minus {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- n evalto 3 by E-Var1 {};
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 3 |- 2 evalto 2 by E-Int {};
                  3 minus 2 is 1 by B-Minus {};
                };
                fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- if n < 3 then 1 else fib (n - 1) + fib (n - 2) evalto 1 by E-IfT {
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- n < 3 evalto true by E-Lt {
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- n evalto 1 by E-Var1 {};
                    fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- 3 evalto 3 by E-Int {};
                    1 less than 3 is true by B-Lt {};
                  };
                  fib = ()[rec fib = fun n -> if n < 3 then 1 else fib (n - 1) + fib (n - 2)], n = 1 |- 1 evalto 1 by E-Int {};
                };
              };
              1 plus 1 is 2 by B-Plus {};
            };
          };
        };
        3 plus 2 is 5 by B-Plus {};
      };
    };
  };
};

どうですか、心は折れましたか?なんか検索してみると「《強力なエディタ》とスニペットさえあれば人力でもいける」と主張する人がぼちぼち見つかるんですが、わたしは《強力なエディタ》を使いこなす力を持ちあわせていないのであっさり諦めました。

方針

とりあえず実装に使う言語はOCamlに決定しました。わたしが使うことのできる言語のなかで最もプログラミング言語処理系の作成に向いているのがOCamlだからです。

そうはいってもわたしのOCaml経験はLazy Kで世界に挨拶(OCamlの練習) - AdC用にとりあえず用意したブログでLazy Kのコードを吐くプログラムを書いたくらいで、yaccも使ったことがなくて言語処理系をつくるには微妙なところでしたが、天下の京都大学が公開しているプログラミング言語処理系の講義資料IoPLMaterials | Materials for the class “Implementation of Programming Languages” in Kyoto University.がとてもいい感じだったのでそれを足掛かりにしてどうにかプログラムを書くことができました。

講義資料に習ってビルドシステムにはdune、構文解析と字句解析にはmenhirとocamllexを使います。

ここで「導出システムの数だけプログラムを別々に作る」のと「複数の導出システムを同居させる」ので迷ったんですが、EvalML1〜EvalML5は互換性があるだろうと期待していたわたしは後者を選択しました。

結論をいえば前者の方が楽です。後述しますが、導出システムはEvalML1〜EvalML5でも微妙に互換性のない部分があるので後者を選択すると構文解析とかでいろいろと悩むことになってしまいます。その悩みの内容というのは操作的意味論や型システムとは関係ない非本質な部分なので悲しいですね。

知見

以下は演習システムを触ったことがある人向けの内容になります。

EvalML3

(再帰)関数抽象と適用を扱う導出システムです。人力でやると心が折れます。

互換性

EvalML3はEvalML2の完全な上位互換で、EvalML2で正しい導出はEvalML3でも正しいことになります。

当然のことのように思えますが、実はこのような互換性があるのはEvalML2とEvalML3の間だけで、EvalML3より上位の導出システムは些細な違いがあってEvalML3との互換性がありません。悲しいですね。

循環参照

EvalML2では値をValueモジュール、環境をEnvモジュールで管理していたんですが、EvalML3で第一級関数を導入すると

  • 環境は値をもつ(EnvはValueに依存する)
  • 関数の値は関数閉包として環境をもつ(ValueはEnvに依存する)

ということで循環参照が発生してしんでしまいました。ここでは応急処置としてEnvモジュールを削除してValueモジュールに統一して相互再帰のデータ型を定義しましたが、再帰モジュールにしてもよかったかもしれません。

EvalRefML3

参照と副作用を扱う闇の導出システムですが、参照と値の対応である「ストア」を値として持って回すことで評価関数自体は純粋につくることができます。おもしろいですね。

互換性

EvalRefML3は環境のほかにストアというものが登場して、構文も拡張されます。しかし空のストアは表記を省略できるので、EvalML3と導出に互換性があるように思えます。

しかしながら、何故かEvalRefML3に限ってe * eという式に対応する導出規則がE-TimesではなくてE-Multであるという罠があります。謎です。

どうしようもないので、式を評価するまえに構文を調べて導出システムのバージョンを検出して、それを導出関数にわたすという解決策をとりました。

ロケーションの名前と入力の終端

ストアは参照のアドレスを表す「ロケーション」というものを持っているのですが、導出システムの表記の都合上、これには名前をつけてあげる必要があります(@lとか@l1とか)。じゃあこの名前は適当に生成していいのかというとそんなことはなくて、与えられる判断に出現する名前と同じにしないといけません。

|- let x = ref 2 in let y = ref 3 in
   let refx = ref x in let refy = ref y in
   let z = !refx := !(!refy) in !x
  evalto 3 / @l1 = 3, @l2 = 3, @l3 = @l1, @l4 = @l2

例えば上の判断の導出を作成するときは、ロケーションの名前は@l1 @l2 @l3 @l4にする必要があるわけです。

ここでひとつ(本質的ではない、どうでもいい)問題が浮上します。

今までは、判断を導出するために必要な情報はevaltoより前に全て与えられていて、evaltoの後の情報は必要ありませんでした。するとevaltoを入力の終端として扱うことができるので、

  1. プログラムを起動する
  2. 演習システムで与えられた判断をコピペする
  3. Enterキーを押す

だけで入力の終端を意味するevaltoが読み込まれて、プログラムは入力の読み込みを完了して結果を返してくれます。わたしはこの操作感にやたらこだわっていました。

一方で今回はevaltoより後の情報が必要になります。ここで、最も右側にくるストアの構文は@l1 = 1, @l2 = 2, ...とどこまでも続く可能性があるので、別に終端を表す記号を与えない限りプログラムは入力を永遠に待ち続けることになります。終端を表す記号といえばCtrl DでEOFを与えるか、;;と書くかといったところでしょうか。

しかし当時のわたしは何故か「コピペ→Enter→終わり」の流れを死守しようとして、以下の方法を思いついて実装しました。

  1. まずevaltoを終端として入力を取り、評価、導出を行う。ロケーションの名前には適当に生成したものを用いる。
  2. すると生成されるロケーションの数がわかるので、個数分だけ <Value> / <Loc>または= <Value> , <Loc>という文法で構文解析を行いロケーション名前を取り出す。終端記号は必要ない。
  3. 導出中のロケーションの名前を全て書き換える。

なかなか邪悪な方法ですが、とにかく「コピペ→Enter→終わり」の流れは守られました。演習問題を解くのには差し支えありません。これを実装できたときは自分の邪悪さに笑い転げていたような覚えがあります。人生楽しそうですね。

もし今作り直すなら譲歩して

  1. まずevaltoを終端として入力を取り、導出システムを検査する。
  2. EvalRefML3だったときに限り、追加で入力と終端記号を要求する

という感じにすると思います。

EvalML4, EvalML5

リストとパターンマッチを扱う導出システムです。素数列挙とかが可能になります。

互換性

変数の値を取り出す導出規則E-Var1 E-Var2E-VarひとつにまとめられたことでEvalML3との互換性を失っています。

それから、EvalML4とEvalML5のパターンマッチは構文も導出規則も異なることに注意が必要です。

TypingML4

多相性のない型システムを扱う導出システムです。

コードの再利用

TypingML系列は今までのEvalML系列とは大きく異なる導出システムで、共通しているのは式の構文(Exp)と導出の表記方法くらいです。

ここで共通する部分は使いまわせるように、今までEvalMLのみに対応していた導出関連のモジュールをファンクターにしたりしました。

導出システムの判別

TypingML系列は式に続いてevaltoのかわりに:が入るので、そこでEvalML系列と判別をすることが可能です。空の環境と空の型環境でreduce/reduce conflictが発生したりしますが、少し工夫するとなんとかなります。

型推論

MLは関数の引数の型を明示しないので、単純型システムといってもプログラムに導出させるには型推論が必要になります。最後の章に型推論アルゴリズムが載っているので実装しましょう。

さて、TypingML4は多相性こそありませんが、それでも型推論アルゴリズムにはPolyTypingML4で定義される型変数を用います。すると式と型環境の情報だけでは型が代入されない型変数が現れることがあります。

最も単純な例はfun x -> xという関数です。

次の判断に対しては、

|- fun x -> x : int -> int

次の導出が与えられます。

|- fun x -> x : int -> int by T-Fun {
  x : int |- x : int by T-Var {};
};

一方、次の判断に対しては

|- fun x -> x : (int -> int) -> (int -> int)

次の導出が与えられます。

|- fun x -> x : (int -> int) -> int -> int by T-Fun {
  x : int -> int |- x : int -> int by T-Var {};
};

与えた型環境と式は同じなのに導出が違いますね。導出に:以降の情報を必要とするやつです。EvalRefML3で同じようなことがありました。

さすがに今回EvalRefML3で行ったような邪悪な方法は使わないし、それはおそらく不可能です。型変数が型推論の結果に現れたときは、求める型(と終端記号)を入力してもらって、それらを対応づける型の連立方程式を組んで導出を書き換えます。

それから、型変数が内側に残ることがあります。次のような場合です。

|- (fun x -> fun y -> x) 1 (fun x -> x) : int by T-App {
  |- (fun x -> fun y -> x) 1 : ('_a4 -> '_a4) -> int by T-App {
    |- fun x -> fun y -> x : int -> ('_a4 -> '_a4) -> int by T-Abs {
      x : int |- fun y -> x : ('_a4 -> '_a4) -> int by T-Abs {
        x : int, y : '_a4 -> '_a4 |- x : int by T-Var {};
      };
    };
    |- 1 : int by T-Int {};
  };
  |- fun x -> x : '_a4 -> '_a4 by T-Abs {
    x : '_a4 |- x : '_a4 by T-Var {};
  };
};

PolyTypingML4ならこれで正解なんですが、TypingML4に型変数はないので不正解になってしまいます。このような型変数はintかboolで塗りつぶすとよいです。

PolyTypingML4

let多相の型システムを扱う導出システムです。プログラムで解くために実装するのはHindley-Milner型推論ってやつでしょうか?

互換性

TypingML4で型付けできる式はすべてPolyTypingML4で型付けできますが、それはそれとして導出の形式をみるとTypingML4とPolyTypingML4に互換性はありません。しかも式や型環境から両者のどちらを使うべきか判別することができない場合があります。仕方がないのでコマンドライン引数--no-polyを用意して、どちらを使うか指示できるようにしました。

ところで、TypingML4のT-FunはPolyTypingMLでは何故かT-Absに名前が変更されています。謎です。

型変数の名前

PolyTypingML4には型変数があるので、名前付きの型変数が与えられることがあります。一方で、型推論の過程で新しい型変数を生成するということもあります。

両者を明確に区別するために、型変数を表す型の定義は次のようにしました。

type t = Generated of int | Named of string

そして、型の連立方程式で「型変数どうしが等しい」という関係が現れたら、名前付きの型変数が優先的に生き残るようにします。こうすることで演習システムに怒られない導出を吐けるわけです。

ちなみに型変数を生成するコードは以下のとおりです。副作用バンザイですね。

let varnum = ref 1

let generate () =
  let v = !varnum in
  incr varnum;
  Generated v

EvalContML1

継続(continuation)という概念を扱う導出システムです。導出がほぼ一直線になります。

どうでもいいんですが、わたしはEvalContML系列は継続渡しスタイルで実装してみました。

コードの再利用

これもEvalML系列とは大きく異なる導出システムですが、式(Exp)や値(Value)は共通しているので、それらのコードを再利用することができます。

導出システムの判別

構文は継続を書けるように拡張されていますが、空の継続を省略することが認められていて、省略されるとEvalML1と見分けがつかなくなってしまいます。そのせいで入力からEvalCont系列であることを判別できないので、諦めてコマンドライン引数--contを用意しました。

EvalContML4

第一級継続を扱う導出システムです。Schemeとかにあるやつですね。

互換性

EvalContML4には環境があって、これは省略できないので、EvalContML1と互換性はありません。まあ環境をoption型で持ったりしてどうにかすればコードはほとんど再利用できます。

循環参照

継続をContモジュール、値をValueモジュールで管理していると、第一級継続を導入するときに循環参照が発生します。わたしは再帰モジュールにして解決しました。

切り捨てた導出システム

Nat系列

これらは全て人力で解き終わっていたので実装しませんでした。 導出システムの数が多いわりに問題数は少ないのでプログラムで解かせる必要はないんじゃないかと思いますが、うまくコードを再利用すると早いかもしれないですね。

EvalML1Err

推論規則の数がやたら増えるから、という理由で実装しませんでした。 EvalMLでは推論規則の名称をヴァリアント型で表していて、推論規則が大量に増えると型の定義が大きくなって大変だったのです。今思うと、推論規則の名称はそのまま文字列で表すべきでした。

NamelessML3

NamelessML3は環境と式を名前無し表現に書き換えるだけなので、それほど大変ではないだろうと考えて人力で導出しました。

EvalNamelessML3

実はEvalNamelessML3用のブランチがこっそり切ってあって、そこに実装してあります。 なぜ分けてしまったのかというと、EvalNamelessML3の構文はEvalML1の構文(環境なしに式から書き始める構文)とshift/reduce conflictを引き起こすのが理由なのですが……

  • なぜコマンド引数で分岐することを検討しなかったのか
  • なぜ人力導出が容易なEvalML1ではなくEvalNamelessML3を切り捨てたのか

このように2点ツッコミどころがあります。しかし解いてしまったモノを再実装するのも面倒なので放置中です。

While言語

もはやMLではないので、別にプロジェクトを用意してOCamlで同じように実装しました。 While言語は関数がなかったり、intとboolが構文レベルで区別されてたりするので実装は簡単な癒し系です。実装にかかった時間は3時間くらいでした。

雑記

menhirのコンフリクト情報を得る

パーサジェネレータのmenhirがわけのわからんコンフリクトで文句を言ってくる、というときは--explainオプションをつけることで大変わかりやすい説明を.conflictファイルに吐いてくれます。duneでビルドする場合次のような設定を書きます。

(menhir
 (modules parser)
 (flags --explain))

演算子優先順位と入出力

本で与えられる定義に括弧は書かれていないからつい忘れてしまうのですが、リストの値(1 :: 2) :: 3とか関数の型(int -> int) -> intとかを出力するときには括弧が必要になるし、パーサも括弧に対応させておく必要があります。

式の出力は優先順位がだいぶややこしいです。例えば、負数の優先順位が関数適用より低いということを忘れるとf (-1)f -1になって怒られたりします。式を与えると優先順位を吐く関数を用意して括弧付けを一般化すると楽になります。

WSL2でOCamlとSATySFiを動かす

OCamlWindowsで動かすにはいろいろと問題があるらしい。しかしWSL2ならなんとかなるんじゃないかと思ってインストールしてみたら、嬉しいことに特別な配慮をすることなく動かすことができた。

WSL2の導入

WSL2はこの春(2020年)に一般提供されるらしいが、まだ正式にリリースされていない。待ちきれないのでWindows Insider Programに登録して先に使わせてもらおう。

LinuxディストリビューションにはUbuntu 18.04 LTSを選択した。Ubuntu 16.04 LTSだとopamのインストールに関していろいろと面倒なことがありそうである。

導入は公式の指示通りにやればできる。資料が日本語なのでうれしい。 docs.microsoft.com

Windows Terminalの導入

WSL2はコマンドプロンプトPowerShellから使えるのだが使い勝手が怪しい。ちょうどマイクロソフトが出しているWindows Terminal (Preview)がよさそうなのでMicrosoft Storeからインストールして使うことにした。

いくつかWindows Terminalの設定をいじくる。設定ファイルはJSONで書かれている。

WSLを起動するとカレントディレクトリが/mnt/c/Users/(Windowsユーザ名)の状態で開始される。これをホームディレクトリに変更したい。
profilesにあるUbuntuのprofileに以下の項目を加える。

"startingDirectory": "//wsl$/Ubuntu-18.04/home/(UNIXユーザ名)"
  • カラースキーム

わたしは個人的にIcebergが好きなのでIceberg color scheme for Windows Terminal · GitHubから色設定をもってきた。

ただしgreenが背景になったとき文字が見づらくなるので、greenだけ元の色のRGB値をそれぞれ半分にした"#5a5f41"に変えてある。

opamのインストール

まずOCamlコンパイラなどをビルドするために必要なソフトウェアをインストールしておく。

sudo apt update
sudo apt install build-essential m4

次にopamをインストールするのだが、aptで入るopamはバージョンが古いのでよろしくない。
opam - Installに従って次のようにすると最新安定版が入る。

sudo add-apt-repository ppa:avsm/ppa
sudo apt update
sudo apt install opam

あとは普通に初期設定をする。--disable-sandboxingなどの変なオプションは必要ないので安心。

opam init
eval $(opam env)

これでOCamlが使えるようになった。非常にうれしい。

$ ocaml
        OCaml version 4.10.0

# print_endline "hogeeeee";;
hogeeeee
- : unit = ()
#

SATySFiのインストール

OCamlが入ったので、調子に乗って GitHub - gfngfn/SATySFi: A statically-typed, functional typesetting system も導入してしまった。

基本的にreadmeの通りにやればインストールできるのだが、つい先日(2020/4/5)にSATySFiがサポートするOCamlのバージョンが4.06.0から4.08.0以上に引き上げられて、2020/4/9現在readmeが更新されていないのでそこだけ注意が必要である。

readmeに依存するソフトウェアの一覧があるので、ないものはインストールしておく。

sudo apt install ruby

SATySFi用のスイッチを作成する。ここでOCamlのバージョンには以前4.10.0でビルドに失敗したので4.08.0を選択したが、今は4.10.0がサポートされていそうだ。

opam switch create satysfi 4.08.0
eval $(opam env)

なおSATySFi用のスイッチでインストールを行うと、スイッチをデフォルトに戻したときsatysfiコマンドが見つからないということになってしまう。この面倒をいくらか減らすにはスイッチの自動切換え機能を使うとよい。SATySFiを扱うディレクトリでopam switch link satysfiを実行すれば、以降はそのディレクトリ以下では自動的にスイッチがsatysfiに切り替わるようになる。

あとは適当なインストールディレクトリにてreadmeに従って次のコマンドを順に実行するとインストールが完了する。

opam repository add satysfi-external https://github.com/gfngfn/satysfi-external-repo.git
opam update

git clone https://github.com/gfngfn/SATySFi.git
cd SATySFi

opam pin add satysfi .
opam install satysfi

./download-fonts.sh
sudo ./install-libs.sh

最後のinstall-libs.shはsudoがないと実行できなかった、、、

デモをコンパイルしてみよう:

cd demo
make
explorer.exe .

f:id:rood_ni:20200409180711p:plain
demo

explorer.exe .を実行することでwindowsエクスプローラーからLinuxファイルシステムを覗けるので、そこから出力されたpdfを簡単に見ることができる。

Lazy Kで世界に挨拶(OCamlの練習)

Lazy KでHello, world!をやりたいがSKIコンビネータは書きたくない。
最近OCamlの勉強をはじめたのでラムダ式をLazy Kのコードに変換するプログラムを書くことにする。

変換

コンビネータ論理 - Wikipediaをみるとなんか変換する方法が書いてあるので、そのままプログラムにしてしまいたい。

  1. T[x] => x
  2. T[(E₁ E₂)] => (T[E₁] T[E₂])
  3. T[λx.E] => (K T[E]) (if x does not occur free in E)
  4. T[λx.x] => I
  5. T[λx.λy.E] => T[λx.T[λy.E]] (if x occurs free in E)
  6. T[λx.(E₁ E₂)] => (S T[λx.E₁] T[λx.E₂])

変換の過程でラムダ項とコンビネータ項が混在したものを扱う必要があることがわかる。

ラムダ項・コンビネータ項を定義

そういうわけで、ラムダ項とコンビネータ項をまとめて定義してしまった。

type term =
  | Var of string
  | Abs of string * term
  | App of term * term
  | S
  | K
  | I

最初はわけて定義するつもりだったが、そうすると関数適用が重複したりして面倒なことになりそうである。もしかして多相ヴァリアントの機能を使うとうまく定義できたりする?

ついでに項を文字列化する関数string_of_termを作成したが、これはHello, world!には使わないので折り畳んでおく。

string_of_term

括弧の省略規則がややこしくて苦労した。もっとエレガントな書き方があるかもしれない。

let rec string_of_term t =
  let parenthesize s = "(" ^ s ^ ")" in
  let rec abs v t isBegin =
    let sep = ". " in
    (if isBegin then "λ" else " ")
    ^ v
    ^
    match t with
    | Abs (v', t') -> abs v' t' false
    | App (t1', t2') -> sep ^ app t1' t2' true
    | _ as t' -> sep ^ string_of_term t'
  and app t1 t2 isBegin =
    ( match t1 with
    | Abs (v', t') -> parenthesize (abs v' t' true)
    | App (t1', t2') -> app t1' t2' false
    | _ as t' -> string_of_term t' )
    ^ " "
    ^
    match t2 with
    | Abs (v', t') ->
        let s = abs v' t' true in
        if isBegin then s else parenthesize s
    | App (t1', t2') -> parenthesize (app t1' t2' true)
    | _ as t' -> string_of_term t'
  in
  match t with
  | Var v' -> v'
  | Abs (v', t') -> abs v' t' true
  | App (t1', t2') -> app t1' t2' true
  | S -> "S"
  | K -> "K"
  | I -> "I"

抽象除去

基本的にWikipediaに書いてあることをそのままプログラムに書くと抽象除去ができる。

(* 変数が項の自由変数であるかを求める *)
let rec is_free_variable v = function
  | S | K | I -> false
  | Var v' -> v = v'
  | App (t1, t2) -> is_free_variable v t1 || is_free_variable v t2
  | Abs (v', t) -> if v = v' then false else is_free_variable v t

(* 抽象除去 *)
let rec eliminate_abstraction = function
  | (S | K | I | Var _) as x -> x
  | Abs (v, App (t, Var v')) when v = v' && not (is_free_variable v t) ->
      eliminate_abstraction t
  | App (t1, t2) -> App (eliminate_abstraction t1, eliminate_abstraction t2)
  | Abs (v, t) when not (is_free_variable v t) ->
      App (K, eliminate_abstraction t)
  | Abs (v, Var v') when v = v' -> I
  | Abs (v, Abs (v', t)) ->
      eliminate_abstraction (Abs (v, eliminate_abstraction (Abs (v', t))))
  | Abs (v, App (t1, t2)) ->
      App
        ( App (S, eliminate_abstraction (Abs (v, t1))),
          eliminate_abstraction (Abs (v, t2)) )
  | _ -> assert false

条件(if x does not occur free in E)の判定のため愚直に探索する関数を用意した。非効率っぽい気がするが、どうせそれで困るほど大規模なラムダ式を書くことはないだろう…

eliminate_abstractionのパターンマッチの上から2番目はイータ変換に相当する。この行をコメントアウトしても関数は正しく動作するが、あるとコンビネータ項がいくらか小さくなる。実のところ私はイータ変換した式が必ずLazy Kの処理系で元どおりに評価されるのかどうかわかっていないのだが、今回試した範囲では問題なかった。

せっかくだからいろいろ試してみよう。

let exps =
  [
    Abs ("x", Var "x");
    App (Abs ("x", App (Var "x", Var "x")), Abs ("x", App (Var "x", Var "x")));
    Abs
      ( "f",
        App
          ( Abs ("x", App (Var "f", App (Var "x", Var "x"))),
            Abs ("x", App (Var "f", App (Var "x", Var "x"))) ) );
  ]

let show t =
  string_of_term t ^ " ==> " ^ string_of_term (eliminate_abstraction t)

let () = print_endline @@ String.concat "\n" @@ List.map show exps

出力↓

λx. x ==> I
(λx. x x) λx. x x ==> S I I (S I I)
λf. (λx. f (x x)) λx. f (x x) ==> S (S (S (K S) K) (K (S I I))) (S (S (K S) K) (K (S I I)))

よくわからないが、おそらく大丈夫だろう…

コンビネータ項の文字列化

これはとても簡単。

let rec string_of_ski = function
  | S -> "s"
  | K -> "k"
  | I -> "i"
  | App (t1, t2) -> "`" ^ string_of_ski t1 ^ string_of_ski t2
  | Abs _ -> failwith "Given expression contains lambda abstraction"
  | Var _ -> failwith "Given expression contains free variables"

ただし英語には自信がない。

リスト

Lazy Kのconsはラムダ式で表すとλx y f. f x yになる。nilはない。

次のようにconsを定義した。

let cons x y = Abs ("f", App (App (Var "f", x), y))

数と文字

最適化に気を配る余裕はない。愚直にチャーチ数を生成する関数を用意する。

(* intをチャーチ数に変換 *)
let nat n =
  let rec tailnat m t =
    if m = 0 then t else tailnat (m - 1) (App (Var "s", t))
  in
  Abs ("s", Abs ("z", tailnat n (Var "z")))

(* charをチャーチ数に変換 *)
let natc c = nat (int_of_char c)

Hello, world!

let program =
  App
    ( K,
      cons (natc 'H')
      @@ cons (natc 'e')
      @@ cons (natc 'l')
      @@ cons (natc 'l')
      @@ cons (natc 'o')
      @@ cons (natc ',')
      @@ cons (natc ' ')
      @@ cons (natc 'w')
      @@ cons (natc 'o')
      @@ cons (natc 'r')
      @@ cons (natc 'l')
      @@ cons (natc 'd')
      @@ cons (natc '!')
      @@ App (K, nat 256) )

let code = string_of_ski (eliminate_abstraction program)

let () = print_string code

プログラムの頭にKコンビネータを置くことで入力を無視することができる。
どうでもいいことだが、プログラムの先頭にAppと書いてあると「アプリケーション」の略語っぽく見えるなと思ったら、「アプリケーション」と「適用」は両方ともApplicationだから同じだった。

Lazy Kの出力の終端は256で表される。リストの終端はcons 256 I(終端以降の出力は検査されないのでconsの第2引数には適当な関数を食わせておく)などとしても良いのだが、The Lazy K Programming LanguageをみるとK 256が簡単だと書いてある。手計算してみよう。

(K 256) (λa b. a) ==> (λx. 256) (λa b. a) ==> 256

なるほど、Kの定義を考えればたしかにcarが256になる。

これでHello, world!の完成である。 出力されたLazy KのプログラムはLazy K Playgroundで手軽に試すことができた。感謝。

雑多な話題

出力されたプログラムの長さを計算したら14191バイトもあった。一方でLazy K - Esolangに載っているHello worldのコードは1000バイト弱なので、短縮の余地はいくらでもあるのだろう。Lazy Kの世界も奥が深そうだ。

Lazy Kの処理系を作りたいという願望があるのだが、いまのところ作り方がよくわからない。とりあえずラムダ計算やSKIコンビネータ計算の簡約を実装するところからはじめていきたいなぁと思っている。

追記: OCamlのコードのインデントをいくらか修正した。

最古のbrainfuck処理系と言語仕様【Brainf*ck Advent Calendar 2019 9日目】

この記事はBrainf*ck Advent Calendar 2019 - Adventarの9日目の記事です。


brainfuckは最も有名な難解プログラミング言語といえそうである。

brainfuckの人気を支えているのはその言語仕様の分かりやすさだろう。brainfuckコンパイラを限界まで簡単にするために設計された言語であるから、他の難解言語と比較すると命令は非常に読みやすく理解しやすい。それどころか、覚えることの少なさを考慮すれば、実用性のある高級言語よりもさらに敷居が低いといえるのではないだろうか。

このように言語仕様の単純明快さが長所のbrainfuckだが、実は罠がある。それは処理系依存の動作が多数存在していることだ。とくに処理系の違いによってプログラムの内容に大きな変化が生まれそうなのが次の2つである:

  • セルの値の範囲(サイズはいくらか?負の数を扱えるか?)
  • ラップアラウンドの有無(例えばセルが8ビットのとき、値が255のセルで+を実行すると値が0に戻るか?)

例えば「1番目のセルの値が1でないとき、2番目のセルの値を1増やす」ようなプログラムを書くとき、次のように実装したくなる。

- [[-] > + <]

しかしラップアラウンドを行わない処理系において、このプログラムは1番目のセルの値が0であるとき正常に動作しない。つまり、可搬性がないということである。

私はこれらの可搬性の問題を知ったとき、そもそも自分が日本語版Wikipedia等に書かれたbrainfuckの言語仕様しか読んだことがなくて、その出典を知らないということに気がついた。 また、brainfuckについて書かれた日本語の記事の多くは、言語仕様の詳細や可搬性の問題への言及をWikipediaへの参照に止めている。

そこで自分なりにbrainfuckの言語仕様の出典を探して日本語でまとめてみようと考え、この記事を書くに至った。本記事の目標は、 brainfuck設計者であるUrban Müllerの処理系に示された言語仕様を把握する ことである。

Urban Müllerの処理系

brainfuckは、できるだけコンパイラが小さくなるチューリング完全プログラミング言語としてUrban Müllerによって設計された1。Urban Müllerは1993年に最初のbrainfuckコンパイラ(296バイト)をAminet(パーソナルコンピューターAmiga関連のソフトウェアアーカイブ)にアップロードしたらしい2
たいへん残念なことに私にはその最初の処理系を見つけることができなかったが、Urban Müllerが同じく1993年にアップロードした、2番目のバージョンと思われる処理系のアーカイブ(brainfuck-2.lha)はAminet - dev/lang/brainfuck-2.lhaからダウンロードすることができる(2019年12月現在)。この2番目の処理系からbrainfuckの言語仕様を読み解くのが本記事の趣旨だ。

brainfuck-2.lhaを解凍すると、readmeのほか以下のプログラムを得られる。

名前 説明
bfc brainfuckコンパイラ (240バイト! )
bfc.asm コンパイラのソース
bfi brainfuckインタプリタ
bfi.c インタプリタのソース (移植性がある)
src/ brainfuckのサンプルプログラム集
src/atoi.b サンプル: 標準入力から数値を読む
src/div10.b サンプル: ポインタの指す数値を10で割る
src/hello.b サンプル: Hello World!
src/mul10.b サンプル: ポインタの指す数値を10倍する
src/prime.b サンプル: 与えられた上限まで素数を計算する
src/varia.b サンプル: SWAPやDUPなど、プログラムの断片集

ちなみに先述した「最初の」brainfuck処理系についてreadmeで言及がなされている。

WHATS NEW
=========

Yes, I squeezed another ridiculous 56 bytes out of the compiler. They have
their price, though: The new compiler requires OS 2.0, operates on a byte
array instead of longwords, and generates executables that are always 64K
in size. Apart from that the language hasn't changed. Again:
***  OS 2.0 *required* for the compiler and the compiled programs  ***

コンパイラから56バイトを圧搾した旨が書かれていることから以前のコンパイラが296バイトであったことがわかり、これは英語版Wikipediaの記述と一致する。 その他、コンパイラの動作にAmiga OS 2.0が必要になったほか、配列要素のサイズがlongword(Amigaでは32ビット?)からbyteに変化したようだ。

readmeの言語仕様を読む

readmeにはbrainfuckの説明が以下のように書かれている。

THE LANGUAGE
============

The language 'brainfuck' knows the following commands:

 Cmd  Effect                                 Equivalent in C
 ---  ------                                 ---------------
 +    Increases element under pointer        array[p]++;
 -    Decrases element under pointer         array[p]--;
 >    Increases pointer                      p++;
 <    Decreases pointer                      p--;
 [    Starts loop, counter under pointer     while(array[p]) {
 ]    Indicates end of loop                  }
 .    Outputs ASCII code under pointer       putchar(array[p]);
 ,    Reads char and stores ASCII under ptr  array[p]=getchar();

All other characters are ignored. The 30000 array elements and p are being
initialized to zero at the beginning.  Now while this seems to be a pretty
useless language, it can be proven that it can compute every solvable
mathematical problem (if we ignore the array size limit and the executable
size limit).

読み取れる仕様を全て日本語化した。

  • brainfuckには次に示す8つの命令がある:
命令 効果 同等なC言語の文
+ ポインタの指す要素をインクリメントする array[p]++;
- ポインタの指す要素をデクリメントする array[p]--;
> ポインタをインクリメントする p++;
< ポインタをデクリメントする p--;
[ ポインタの指す値をカウンタとしてループを開始する while(array[p]) {
] ループの終わりを示す }
. ポインタの指すASCIIコードを出力する putchar(array[p]);
, 1文字読み込み、ポインタの指す位置にASCIIコードを代入する array[p]=getchar();
  • 上記以外の全ての文字は無視される
  • 配列の要素数は30000である
  • 最初、配列の要素およびポインタはゼロで初期化されている

この説明で未定義の事項として、以下の4つを挙げることができる。

  1. セルの値の範囲
    セル(配列の要素)の値の範囲は定義されていない。先述したとおり、おそらくUrban Müllerの最初のコンパイラと次のコンパイラでも実装が異なる。ただしASCIIコードの入出力を行う機能があるため、少なくとも0〜127を扱うことができるものとしてよさそうである。
  2. セルのオーバーフロー
    インクリメントやデクリメントの結果、セルがオーバーフローするときの動作は定義されていない。
  3. 配列外参照
    ポインタが配列の端より向こう側に移動したときの動作は定義されていない。
  4. EOF
    入力命令,がEOFをどのように扱うか定義されていない。

インタプリタを読む

Urban Müllerの処理系にはC言語で記述されたインタプリタソースコードbfi.cが付属しているので、先ほど述べた4つの未定義の事項に対してインタプリタがどのように振る舞うのか確認することができる。

1. セルの値の範囲

セルの配列aが4行目で宣言されている。

char a[5000], f[5000], b, o, *s=f;

セルがchar型であることがわかる。
やっかいなことに、C言語の規格3によると、char型が符号付きであるかどうかは処理系に依存する4らしい。 残念ながら変数宣言部分からはセルの符号の有無について有益な情報は得られないようだ。unsignedsignedがついていればよかったのだが。

2. セルのオーバーフロー

C言語では符号無しの計算ではオーバーフローが起こらないが、符号ありの計算のオーバーフローの動作は未定義である5

したがってchar型が符号無しであるような処理系でコンパイルされたbfi.cはセルをラップアラウンドすることがわかる。一方、char型が符号付きであるような処理系についてラップアラウンドがあるかどうかはわからない6

3. 配列外参照

ポインタが配列外に移動したときに対応するコードが39、40行目に書かれている。

if( p<0 || p>100)
  puts("RANGE ERROR"), exit(0);

ポインタが負の番地、または100より大きい番地を指したときインタプリタRANGE ERRORを出力して正常終了する。

この0〜100という範囲は不思議なことに配列aの要素数である5000個よりも小さく、そもそも配列の要素数がreadmeに示された配列の要素数である30000個よりも小さい。

4. EOF

入力に対応するコードが19行目に書かれている。

case ',': a[p]=getchar();fflush(stdout); break;

getcharはそれ以上入力が存在しないときEOFを返す。マクロEOFは型がintで負の値をもつ整数定数式に展開する7ことが定められているが、具体的な値は規定されていない。

したがって、このインタプリタはEOFとしてint型の負数をchar型に変換した値を用いるが、その値はC言語処理系依存である。

コンパイラを読む

アセンブリはよくわかりません。許してください。

サンプルプログラムを読む

処理系に付属している6つのサンプルプログラムのなかで、未定義の動作を踏んでいるものがないかどうか調べる。とくに、ポインタの指す数値がゼロのときに-命令が実行されることがあるかどうかを確認したい。

しかし他人が書いたbrainfuckのコードを全て読むのは苦行なので、インタプリタを自作して確認することにした。作成したインタプリタのコードの一部を掲載する。

array[ptr]++;
if (array[ptr] > CELL_MAX) {
    std::cerr << "'+' overflow (" << inst.line << ", " << inst.col << ")\n";
    array[ptr] = 0;
}
array[ptr]--;
if (array[ptr] < 0) {
    std::cerr << "'-' overflow (" << inst.line << ", " << inst.col << ")\n";
    array[ptr] = CELL_MAX;
}
if (array[ptr] == EOF) {
    std::cerr << "',' EOF (" << inst.line << ", " << inst.col << ")\n";
    std::exit(0);
}

このようにオーバーフローやEOFを検知することができる。 ここで先に結果を述べてしまうと、セルの値の範囲を0〜255として実行したところ、残念ながら(?)どのサンプルプログラムも未定義の操作を実行することはなかった。

atoi.b

==== ==== ====
cont digi num
==== ==== ====

+
[
 -                         cont=0
 >,
 ======SUB10======
 ----------

 [                         not 10
  <+>                      cont=1
  =====SUB38======
  ----------
  ----------
  ----------
  --------

  >
  =====MUL10=======
  [>+>+<<-]>>[<<+>>-]<     dup

  >>>+++++++++
  [
   <<<
   [>+>+<<-]>>[<<+>>-]<    dup
   [<<+>>-]
   >>-
  ]
  <<<[-]<
  ======RMOVE1======
  <
  [>+<-]
 ]
 <
]
>>[<<+>>-]<<
#

atoi.bは、改行を終端とする非負整数を入力に取り、cont(ソースコード中のコメント参照)に格納するプログラムである。

(\n判定のため)入力された値からいきなり10引いている部分が気になったが、入力が正しく([0-9]*\nの形で)与えられていて、入力された数値が範囲内に収まっている限り、このプログラムに未定義の動作は現れない。

div10.b

==== ==== ==== ==== ====
num  ten  tmp  bool div
==== ==== ==== ==== ====

>+++++++++<
[
 >>>+<<                bool= 1
 [>+>[-]<<-]           bool= ten==0
 >[<+>-]               ten = tmp
 >[<<++++++++++>>>+<-] if ten=0 ten=10  inc div
 <<-                   dec ten
 <-                    dec num
]
>>>>[<<<<+>>>>-]<<<<   copy div to num
>[-]<                  clear ten

div10.bは、numに格納されている値を10で割るプログラムである。小数点以下は切り捨てられる。

numが負でない限りこのプログラムに未定義の動作は現れない。

hello.b

>+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++++>-]
<.#>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>++++++++[
<++++>-]<+.[-]++++++++++.

特筆すべきことはない。

mul10.b

=====MUL10=======
[>+<-]>         ; move num one right ie num2=num
>>++++++++++    ; load 10 into fourth element
[
 <<[<+>>+<-]    ; add num2 to first and third element
 >[<+>-]>       ; num2=third element
 -              ; loop ten times
]
<<[-]<          ; clear num2
#

mul10.bはポインタの指す数値を10倍するプログラムである。

数値が負ではなく、かつ10倍した値がセルの値の範囲内に収まっているとき、このプログラムに未定義の動作は現れない。

prime.b

prime.bのコード(長いので折りたたみ)

===================================================================
======================== OUTPUT STRING ============================
===================================================================
>++++++++[<++++++++>-]<++++++++++++++++.[-]
>++++++++++[<++++++++++>-]<++++++++++++++.[-]
>++++++++++[<++++++++++>-]<+++++.[-]
>++++++++++[<++++++++++>-]<+++++++++.[-]
>++++++++++[<++++++++++>-]<+.[-]
>++++++++++[<++++++++++>-]<+++++++++++++++.[-]
>+++++[<+++++>-]<+++++++.[-]
>++++++++++[<++++++++++>-]<+++++++++++++++++.[-]
>++++++++++[<++++++++++>-]<++++++++++++.[-]
>+++++[<+++++>-]<+++++++.[-]
>++++++++++[<++++++++++>-]<++++++++++++++++.[-]
>++++++++++[<++++++++++>-]<+++++++++++.[-]
>+++++++[<+++++++>-]<+++++++++.[-]
>+++++[<+++++>-]<+++++++.[-]

===================================================================
======================== INPUT NUMBER  ============================
===================================================================
+                          cont=1
[
 -                         cont=0
 >,
 ======SUB10======
 ----------

 [                         not 10
  <+>                      cont=1
  =====SUB38======
  ----------
  ----------
  ----------
  --------

  >
  =====MUL10=======
  [>+>+<<-]>>[<<+>>-]<     dup

  >>>+++++++++
  [
   <<<
   [>+>+<<-]>>[<<+>>-]<    dup
   [<<+>>-]
   >>-
  ]
  <<<[-]<
  ======RMOVE1======
  <
  [>+<-]
 ]
 <
]
>>[<<+>>-]<<

===================================================================
======================= PROCESS NUMBER  ===========================
===================================================================

==== ==== ==== ====
numd numu teid teiu
==== ==== ==== ====

>+<-
[
 >+
 ======DUP======
 [>+>+<<-]>>[<<+>>-]<

 >+<--

 >>>>>>>>+<<<<<<<<   isprime=1

 [
  >+

  <-

  =====DUP3=====
  <[>>>+>+<<<<-]>>>>[<<<<+>>>>-]<<<

  =====DUP2=====
  >[>>+>+<<<-]>>>[<<<+>>>-]<<< <


  >>>


  ====DIVIDES=======
  [>+>+<<-]>>[<<+>>-]<   DUP i=div

  <<
  [
    >>>>>+               bool=1
    <<<
    [>+>+<<-]>>[<<+>>-]< DUP
    [>>[-]<<-]           IF i THEN bool=0
    >>
    [                    IF i=0
      <<<<
      [>+>+<<-]>>[<<+>>-]< i=div
      >>>
      -                  bool=0
    ]
    <<<
    -                    DEC i
    <<
    -
  ]

  +>>[<<[-]>>-]<<
  >[-]<                  CLR div
  =====END DIVIDES====


  [>>>>>>[-]<<<<<<-]     if divides then isprime=0


  <<

  >>[-]>[-]<<<
 ]

 >>>>>>>>
 [
  -
  <<<<<<<[-]<<

  [>>+>+<<<-]>>>[<<<+>>>-]<<<

  >>




  ===================================================================
  ======================== OUTPUT NUMBER  ===========================
  ===================================================================
  [>+<-]>

  [
   ======DUP======
   [>+>+<<-]>>[<<+>>-]<


   ======MOD10====
   >+++++++++<
   [
    >>>+<<              bool= 1
    [>+>[-]<<-]         bool= ten==0
    >[<+>-]             ten = tmp
    >[<<++++++++++>>-]  if ten=0 ten=10
    <<-                 dec ten
    <-                  dec num
   ]
   +++++++++            num=9
   >[<->-]<             dec num by ten

   =======RROT======
      [>+<-]
   <  [>+<-]
   <  [>+<-]
   >>>[<<<+>>>-]
   <

   =======DIV10========
   >+++++++++<
   [
    >>>+<<                bool= 1
    [>+>[-]<<-]           bool= ten==0
    >[<+>-]               ten = tmp
    >[<<++++++++++>>>+<-] if ten=0 ten=10  inc div
    <<-                   dec ten
    <-                    dec num
   ]
   >>>>[<<<<+>>>>-]<<<<   copy div to num
   >[-]<                  clear ten

   =======INC1=========
   <+>
  ]

  <
  [
   =======MOVER=========
   [>+<-]

   =======ADD48========
   +++++++[<+++++++>-]<->

   =======PUTC=======
   <.[-]>

   ======MOVEL2========
   >[<<+>>-]<

   <-
  ]

  >++++[<++++++++>-]<.[-]

  ===================================================================
  =========================== END FOR ===============================
  ===================================================================


  >>>>>>>
 ]
 <<<<<<<<



 >[-]<
  [-]
 <<-
]

======LF========

++++++++++.[-]

prime.bは、atoi.bで入力された数値以下の素数をすべて求めてスペース区切りで出力するプログラムであり、サンプルプログラムの集大成といえる。さすがにこの規模のbrainfuckソースコードは読みたくない。

255までの素数を出力させたが、未定義の動作は現れなかった。

varia.b

[
most of these require the the numbers to the right of the pointer to be 0

CLR  =   [-]
ADD  =   [<+>-]<
DUP  =   [>+>+<<-]>>[<<+>>-]
SWAP =   [>+<-]<[>+<-]>>[<<+>>-]<
MUL  =   >[-]>[-]<< <[>[>+>+<<-] >[<+>-] <-] >>>[<<<+>>>-]<<<
IF   =   >[-]<[>[-]+<-]> (your program here) <

]

varia.bには汎用的に使えるコードの断片が集められている。 どれも当たり障りのなさそうなコードだが、ここで[-]について考察しておきたい。

いままでセルの値が「負」ではないときに未定義の動作が現れない、という表現を何度か使ってきた。しかし負の値を許容するとこれらのプログラムは意図したとおりに動かない可能性があり、その中にはセルの値を0にするという目的の[-]も含まれている。

  • ラップアラウンドを行わない処理系では[-]がクラッシュするか、無限ループに陥る。
  • サイズの大きい(32ビットなどの)セルでは、[-]が終了するために極端に時間がかかることがある。

セルの値が0のときに-命令を実行しうるサンプルプログラムが存在しなかったことも踏まえると、Urban Müllerはセルが負の値をもつことを想定していない、と考えることができそうである。

まとめ

Urban Müllerの処理系を調べてわかったことをまとめる。

  • 各命令がC言語の文と対応付けて説明されている。
  • 8つの命令以外が無視されることがreadmeで明言されている。
  • 配列の要素数が30000個であることがreadmeで明言されている。しかし不思議なことに、インタプリタではそれが守られていない。
  • 配列の各要素およびポインタは0で初期化されることがreadmeで明言されている。
  • セルのサイズは定義されておらず、ただASCIIコードを扱うことができれば良い。実際、最初の処理系と2番目の処理系でも扱いが異なる。
  • セルが負数を扱えるかどうかは定義されていない。インタプリタの実装ではキーワードsignedunsignedが使用されておらず、Urban Müllerの意図は感じられない。また、サンプルプログラムにおいて値が0のセルがデクリメントされることはない。
  • 配列外参照を行なったとき動作は定義されていないが、インタプリタで配列外参照を行うとエラーメッセージが出る。
  • EOFの扱いは定義されていない。

雑記

日本語版Wikipediaによると「Müllerが開発したコンパイラのサイズはわずか123バイト、インタプリタは98バイトであった」とのことである8。しかしながら出典が示されていない。そこで適当に「brainfuck 123 bytes」で検索してみたところサイズが一致するコンパイラインタプリタアーカイブをひとつ見つけたが9、開発者はUrban MüllerではなくJeffry Johnstonであった。断言はできないが、おそらく日本語版Wikipediaの記述が間違っているのだろう。

ほとんどの出典が示されていないだけでなく、日本語版Wikipediabrainfuckの記事は英語版と比べて驚くほど情報の量が少ないのであまり役に立たなかった。

brainfuckに関する情報源としてはbrainfuck - Esolangが最強だと思う。可搬性の問題、歴史、サンプルコードなど、brainfuckに関するあらゆる情報が詳しくまとめられている。もしまだ読んだことがないbrainfuckerがいれば、ぜひ一通り読んでみることをオススメしたい。


  1. “The Brainfuck Programming Language” http://www.muppetlabs.com/~breadbox/bf/ (参照 2019-10-4)「Brainfuck is the ungodly creation of Urban Müller, whose goal was apparently to create a Turing-complete language for which he could write the smallest compiler ever, for the Amiga OS 2.0.」

  2. 英語版Wikipediaの情報だが、出典が示されていなかった。"Brainfuck - Wikipedia" https://en.wikipedia.org/wiki/Brainfuck (参照 2019-10-4)「Müller’s original compiler was implemented in machine language and compiled to a binary with a size of 296 bytes. He uploaded the first Brainfuck compiler to Aminet in 1993.」

  3. JIS X 3010:2003「プログラム言語C」を参照した。

  4. JIS X 3010:2003「プログラム言語C」6.3.1.1「単なる char 型を符号付きとして扱うか否かは,処理系定義とする」

  5. JIS X 3010:2003「プログラム言語C」6.2.5「符号無しオペランドを含む計算は,決してオーバフローしない。すなわち,結果を符号無し整数型で表現できないときは,その型で表現しうる最大値より 1 だけ大きい数を法とする剰余を結果とする。」3.4.3「未定義の動作の例としては,整数演算のオーバフローに対する動作がある。」

  6. これは未定義の動作とも言い切れないような気がする。というのは、次のようなことを考えたからだ。『int型より小さい型は演算前にint型への暗黙の汎整数拡張が行われるという話がある。このとき、char型をint型に変換して行われた演算の結果をchar型に変換すると、定義された動作のみによってラップアラウンドが行われたことになるのではないか?』自信は全くないのでC言語の規格を調べて動作を理解したかったのだが、AdCに間に合わなくなりそうだった、本記事の趣旨はC言語の仕様を調べることではない、むずかしくてよくわからない、などの理由により諦めた。

  7. JIS X 3010:2003「プログラム言語C」7.19.1「EOFは,型が int で,負の値をもつ整数定数式に展開する。」

  8. Brainfuck - Wikipediahttps://ja.wikipedia.org/wiki/Brainfuck (参照 2019-10-5)「実際、Müllerが開発したコンパイラのサイズはわずか123バイト、インタプリタは98バイトであった。」

  9. “Index of /brainfuck/compiled/msdos/jeff” http://esoteric.sange.fi/brainfuck/compiled/msdos/jeff/ (参照 2019-10-5)