optional はコンテナか?

C++ に提案されている機能の内で optional という型がある。 従来は何らかの値を返す関数が失敗した場合にその値がポインタならヌルポインタを、整数なら -1 を返すなどといった「無効値」を使っていたわけだが、正常な値としてヌルポインタや -1 を返す可能性がある関数では別の方法が必要であるし、何より無効であることを確認する方法が一貫していないのはうんざりする。 そういった問題を解決するのが optional である。

optional はまだ仕様に入ったわけではないのだが、 Boost::optional を基礎にした提案であり、 Boost ユーザの中には積極的に使っている人もいるようだ。 最近の MinGW を導入していれば std::experimental::optional という名前で入っている。 公式に提案されている optionalBoost::optional は仕様が異なるので注意を要する。

さて、この optional であるが、 0 個または 1 個の値を入れられるコンテナであるという解釈があるようだ。 他の言語ではそういう解釈を持つものもあるらしい。

私は最近の C++ 事情をあまり追っていないので久々に少し遊んでみようと std::experimental::optionalイテレータを定義してみた。

// optional_iterator.h

template<class T>
class optional_iterator {
private:
  std::experimental::optional<T>* object;
public:
  optional_iterator& operator++(void) {
    return object==nullptr ? *this : (object=nullptr, *this);
  }
  optional_iterator operator++(int) {
    optional_iterator<T> temp = *this;
    this->object = nullptr;
    return optional_iterator<T>(temp);
  }
  optional_iterator(std::experimental::optional<T>& o)
    : object(o==std::experimental::nullopt ? nullptr : &o) {
  }
  optional_iterator() : object(nullptr) {
  }
  bool operator==(optional_iterator x) {
    return object == x.object;
  }
  bool operator!=(optional_iterator x) {
    return !(object == x.object);
  }
  T operator*(void) {
    return object ? **object : T();
  }
};

namespace std {
  template<class T>
  optional_iterator<T> begin(std::experimental::optional<T>& opt) {
    return optional_iterator<T>(opt);
  }

  template<class T>
  optional_iterator<T> end(std::experimental::optional<T>& opt) {
    return optional_iterator<T>();
  }
}

以下のような要領で使える。

#include <experimental/optional>
#include <iterator>
#include <iostream>
#include "optional_iterator.h"

int main(void) {
  std::experimental::optional<int> o1=1;
  for(auto i :o1) std::cout << i <<std::endl; // 1 が表示される
  std::experimental::optional<int> o2;
  for(auto i :o2) std::cout << i <<std::endl; // 表示されない
}

Document ID: 6d8f20d090b1289ff2a744aaa2f04e55

こんな夢を見た「七人ミサキ」

こんな夢を見た。

ある革命活動のリーダーに身の危険が迫っているらしい。 彼は革命を放り出して逃げようとしていたが、その前に影武者を用意した。 それが私だ。

私は整形させられ、薬物を使った洗脳で最初から真実リーダー自身だったかのように思い込まされた。 その処置を行なった人物は、その処置のことを「精神サーフェイサー」と言っていた。

リーダーと同じように振舞い、同じように思考して決めた私の次の行動は「逃げよう。 その前に影武者を用意しよう」ということだった。

Document ID: afd956466985625f4803c8fa0cab6c69

Chicken で transcript-on

先日は Gauche 上に transcript-on / transcript-off を実装した。

プログラミング言語 Scheme の処理系として特に人気のあるもののひとつである CHICKEN ではどうだろうかと試してみたところ同じような要領で書けた。 .csirc に以下を書いておけば利用できるようになる。

(define (%transcript-off)
  (error "Transcript mode not yet."))

(define transcript-off %transcript-off)

(define (transcript-on filename)
  (unless (eq? transcript-off %transcript-off)
    (error "Already in transcript mode."))
  (let ((log-port (open-output-file filename))
        (org-printer ##sys#repl-print-hook)
        (org-reader ##sys#repl-read-hook)
        (org-prompter ##sys#read-prompt-hook))
    (set! ##sys#repl-print-hook
          (lambda(x port)
            (org-printer x port)
            (org-printer x log-port)))
    (set! ##sys#repl-read-hook
          (lambda()
            (let ((obj (read)))
              (display obj log-port)
              (newline log-port)
              obj)))
    (set! ##sys#read-prompt-hook
          (lambda()
            (org-prompter)
            (display ((repl-prompt)) log-port)))
    (set! transcript-off
          (lambda()
            (set! transcript-off %transcript-off)
            (set! ##sys#repl-read-hook org-reader)
            (set! ##sys#repl-print-hook org-printer)
            (set! ##sys#read-prompt-hook org-prompter)
            (close-output-port log-port)
            (if #f #t)))
    (if #f #t)))

ドキュメントを読まずに書いているのでこれが CHICKEN 的にまっとうな方法かどうかわからないし、将来のバージョンの CHICKEN でも使えるかわからないが、変数名に hook と付いているからにはフックに使っていいんだろうと安直に判断した。

Document ID: 9d9afc27c1a84423c4ed3f02739cdbbf

テキストファイルの全部を読んで行単位にする

プログラミング言語 C でテキスト処理をしようと思うと何かと面倒なことは多い。 ただ行ごとに読むというだけのことにでもひどく手間をかけさせられてしまう。 それをなんとか工夫して実装しようとしている記事を読んだ。

もう 20 年ほど前のことになるが、私はチャット CGI を C で書いたことがあり、その中で似たようなことをやったというのを思い出した。 そのときの技法 (というほど大したものではないが) を紹介したいと思う。

考え方

結局ファイル全部を読むのだから一度に読んでしまえば良いではないかというのが基本的な発想だ。 fread 関数を使ってテキスト全部を読めば改行で区切られたひとつの文字列が出来上がる。

f:id:SaitoAtsushi:20160129033040p:plain

改行をヌル文字に置換えた上でそれぞれの行の先頭を指すポインタの配列を作れば、見掛け上は行ごとの文字列になっているかのように見える。

f:id:SaitoAtsushi:20160129033241p:plain

ちなみに、以下の実装では改行が 0d 0a の2バイトの場合、 0a だけの場合のどちらにも対応している。

実装

// whole.h
char** whole(const char* const filename);
void freewhole(char** m);
// whole.c
#include <stdio.h>
#include <stdlib.h>

static long int filesize(FILE* fp) {
  fseek(fp, 0, SEEK_END);
  long int size = ftell(fp);
  fseek(fp, 0, SEEK_SET);
  return size;
}

static int countline(char* block) {
  int line = 0;

  for(int i=0, flag=0; block[i]; i++)
    switch(block[i]) {
    case '\r': line++; flag=1; break;
    case '\n': if(flag) flag = 0; else line++; break;
    default: flag = 0;
    }

  return line+2;
}

static char* nextline(char* str) {
  char* n;
  for(n=str; *n!='\n' && *n!='\r' && *n!='\0'; n++);
  switch(*n) {
  case '\0': return NULL;
  case '\r': *n++='\0'; if(*n=='\n') n++; if(*n=='\0') return NULL; break;
  case '\n': *n++='\0'; if(*n=='\0') return NULL; break;
  }
  return n;
}

static char* readall(const char* const filename) {
  FILE* fp = fopen(filename, "rb");
  if(fp==NULL) {perror(NULL); exit(EXIT_FAILURE); }
  int size = filesize(fp);
  char* block = malloc(size+1);
  if(block==NULL) {perror(NULL); exit(EXIT_FAILURE); }
  int read_size = fread(block, 1, size, fp);
  fclose(fp);
  block[read_size]='\0';
  return block;
}

static char** split(char* block) {
  int linelength=countline(block);
  char** lines = malloc(linelength*sizeof(char*));
  if(lines==NULL) {perror(NULL); exit(EXIT_FAILURE); }
  char** p;
  for(p=lines; block!=NULL; block=nextline(block)) *p++=block;
  *p=NULL;
  return lines;
}

char** whole(const char* const filename) {
  char* block = readall(filename);
  return split(block);
}

void freewhole(char** m) {
  free(m[0]);
  free(m);
}

使用例

// test.c
#include <stdio.h>
#include "whole.h"

int main(void) {
  char** lines = whole("test.txt");

  for(int i=0; lines[i]; i++) printf("%d %s\n", i, lines[i]);

  freewhole(lines);
  
  return 0;
}

利点と欠点

まず利点としては、

  • 考え方が単純でわかりやすい
  • コードが短い
  • コストの大きい処理であるメモリの割付け (malloc) の回数が抑えられている (ので高速である)
  • コストの大きい処理であるメモリの再割付け (realloc) がない (ので高速である)
  • コストの大きい処理である配列のコピーがない (ので高速である)

といった点が挙げられる。

欠点としては、

  • 巨大な連続したメモリ領域が必要

ということがある。 全体のメモリ使用量としては少なくても、行ごとにメモリを確保するのではなくファイルサイズと同じだけのメモリの塊が必要なので、状況によってはメモリ確保に失敗しやすくなる可能性はある。

Document ID: bc963f8df9035ce7f2619ed40ec345b6

Gauche で transcript-on

Gauche は今では R7RS 準拠の Scheme 処理系を名乗っているが、それ以前は R5RS に準拠していた。 しかし、 R5RS の仕様の内で Gauche (の作者) が意図的に無視していた箇所がある。 そのひとつが transcript-on / transcript-off だ。 これらは処理系との対話をファイルに記録する機能の開始・終了を指示する手続きであり、 Gauche では提供されなかった。 Emacs などの開発環境を利用していればその機能で記録を残すことが出来るので言語処理系として提供する必要がなかったということもあるのだろう。

そのかわり read-eval-print-loop という手続きが提供されていて、カスタマイズされた repl を作ることが出来るようになっている。

Gauche ユーザリファレンス: read-eval-print-loop

読み込み手続きや印字手続きがその本来の動作のついでにファイルに記録するようにすれば、処理系が transcript-on / transcript-off 手続きを提供するより自由度の高い記録処理が可能だ。 Gauche を対話モードで起動したときにも内部的には read-eval-print-loop 手続きが使われている。

さて、そこで今回は Gauchetranscript-on / transcript-off を追加することを考えた。 .gaucherc に追加して利用することを想定している。 .gaucherc については Gauche のドキュメントを参照して欲しい。

Gauche ユーザリファレンス: インタラクティブな開発

以下が実装だ。

(with-module gauche.interactive
  (define %repl-print (with-module gauche.internal %repl-print))
  (define (my-printer . vals) (apply %repl-print vals))
  (define (my-reader) (%reader))
  (define (my-prompter) (%prompter))
  (define-in-module user (read-eval-print-loop :optional (reader #f)
                                               (evaluator #f)
                                               (printer #f)
                                               (prompter #f))
    (let ([reader (or reader my-reader)]
          [evaluator (or evaluator (with-module gauche.interactive %evaluator))]
          [prompter (or prompter my-prompter)]
          [printer (or printer my-printer)])
      ((with-module gauche read-eval-print-loop)
       reader evaluator printer prompter)))

  (define (%transcript-off) (error "Transcript mode not yet."))

  (define-in-module gauche transcript-off %transcript-off)

  (define-in-module gauche (transcript-on filename)
    (unless (eq? transcript-off %transcript-off)
      (error "Already in transcript mode."))
    (let ((port (open-output-file filename :buffering :line))
          (old-printer %repl-print)
          (old-reader %reader)
          (old-prompter %prompter))
      (set! %repl-print
            (lambda vals
              (for-each (lambda(e) (write e port) (newline port)) vals)
              (apply old-printer vals)))
      (set! %reader
            (lambda ()
              (rlet1 s (old-reader)
                (write s port)
                (newline port))))
      (set! %prompter
            (lambda ()
              (rlet1 s (with-output-to-string old-prompter)
                (display s) (flush)
                (display s port))))
      (set! transcript-off
            (lambda()
              (close-output-port port)
              (set! %repl-print old-printer)
              (set! %reader old-reader)
              (set! %prompter old-prompter)
              (set! transcript-off %transcript-off)
              (undefined)))
      (undefined)))
  )

では利用してみよう。

saito ~
$ gosh
gosh> (transcript-on "test.txt")
#<undef>
gosh> (+ 1 2)
3
gosh> (sin 0.5)
0.479425538604203
gosh> (transcript-off)
#<undef>
gosh> (exit)

saito ~
$ cat test.txt
#<undef>
gosh> (+ 1 2)
3
gosh> (sin 0.5)
0.479425538604203
gosh> (transcript-off)

transcript-on を実行してから transcript-off を実行するまでの対話がファイルに書き込まれているのがわかる。 ここでは repl に与えた式と戻り値を記録しているので displaywrite の出力結果は記録されないが必要であれば捕捉することは可能だろう。

Document ID: a06002e461443df32d67dd0a18838c33

レトロコンピュータで Scheme 処理系を動かす

レトロというには性能が高すぎるが PC-9801プログラミング言語 Scheme の処理系を動かすことを考えてみる。 このとき拡張メモリはないものと想定する。 つまり、 OS 込みでコンベンショナルメモリ内だけで動作させられるだろうか。 Scheme 処理系としては軽量である TinyScheme (バージョン 1.41) を利用することにした。 単に軽量であるというだけでなくソースコードの構成が単純なのでビルドプロセスを実行するために特別にツールを導入する必要がなく楽だという理由もある。

私が TinyScheme をコンパイルするのに使ったのは Windows 版の Open Watcom C/C++ だ。 (ここではコンパイラの導入方法の説明はしない。)

http://www.openwatcom.org/

Open Watcom compiler suite は DOS 版、 Linux 版、 OS/2 版、 Windows 版が存在して御互いにクロスコンパイルすることもできる。 今回は Windows 版を用いる。 DOS の世界ではファイル名が 8 文字以内という制限があり、 TinyScheme のソースコードの一部はそれより長いファイル名を使っているので書換えるのが面倒だからだ。

当初は Turbo C (フリー版) を使おうかとも思ったが C99 に対応していないので TinyScheme をコンパイルするのには不足だった。

TinyScheme を DOS 用 (16-bit code) にコンパイルするにあたってソースコードを一箇所だけ書換える必要があった。 差分を示す。

--- scheme.c.org	2013-04-15 05:08:34 +0900
+++ scheme.c	2016-01-05 10:50:24 +0900
@@ -4387 +4387 @@
-#define INF_ARG 0xffff
+#define INF_ARG INT_MAX

INF_ARG は手続きのアリティの上限を示すのに使われる定数だ。 引数の数に制限がないような手続きに対して「充分に大きい値」を上限とすることで代用していて、その値が 0xffff であるということである。 しかし、 16 ビットの int では 0xffff は表現不能なので切り詰められてマイナスの値になってしまいまともに動作しなくなるので int の最大値である INT_MAX に置換えている。

あとは以下のようにコマンドを与えれば実行ファイルが生成される。

> wcc scheme.c -fpi87 -oh -ol -om -os -4 -zq -d0 -bt=dos -fo=.obj -ml -DUSE_DL=0 -DUSE_MATH=1 -DUSE_ASCII_NAMES=0 -DUSE_STRLWR=0
> wlink name scheme system dos op stack=16k op q file scheme.obj

ここで生成された scheme.exe と init.scm を適当な方法で PC-9801 環境にもっていけば動作させることが出来る。 init.scm はカレントディレクトリから読まれるということに注意すること。

f:id:SaitoAtsushi:20160105135121p:plain

PC-9801 であれば TinyScheme くらいの軽量な処理系は余裕をもって動作可能であることがわかった。 もっとメモリが少なく速度の遅いコンピュータでも大丈夫だろう。 実用するにはいくらか手続きを追加する必要がある場面もあるだろうが、レトロコンピュータで使うプログラミング言語として Scheme は充分に選択肢に入ると思う。

Document ID: 37c729e92f127e83e6adbbe44a53e49b

レコードもどきを作る

プログラミング言語 Scheme にはレコードという機能がある。 他の言語で構造体などと呼ばれるようなものに似ている。 単に複数のオブジェクトの集合体ということであればリストやベクタで出来てしまうし、 SICP でレコードは用いられない (SICP が書かれた時代は R5RS までしかなく、 R5RS にはレコードはない) ということもあってか、レコードが軽視されている印象があるのだが、コードのわかりやすさにかなり貢献すると私は考えている。

レコードが欲しいとき

ではレコードがどんなときに欲しいか SICP の中からキューを例にとってみよう。

http://sicp.iijlab.net/fulltext/x332.html

SICP の 3.3.2 で定義されているキューはリスト、そしてそのリストの先頭要素と末尾要素を指すペアから成る。 キューのオブジェクトを生成する手続きはこうなっている。

(define (make-queue) (cons '() '()))

make-queue の生成するペアの car フィールドが先頭要素を、 cdr フィールドが末尾要素を指しているのだが、コンストラクタだけを見てもそれを読み取ることは出来ない。 更にアクセサを見て初めてそれぞれが意味するところがわかる。

(define (front-ptr queue) (car queue))
(define (rear-ptr queue) (cdr queue))
(define (set-front-ptr! queue item) (set-car! queue item))
(define (set-rear-ptr! queue item) (set-cdr! queue item))

データのそれぞれが意味するところはデータを操作しているところを見るまでわからないので、データ構造をコードだけ見て理解しづらい。 データ構造やその要素に名前を付け、また同時にアクセサと関連付けたいと考えるのは自然なことではないだろうか。 データ構造とアクセサ、モディファイアは不可分なものだろう。

レコードを使ってみる

上で引用したコードについて R7RS の define-record-type を用いて書くなら以下のようになる。

(define-record-type <queue> (%make-queue front rear) queue?
  (front front-ptr set-front-ptr!)
  (rear  rear-ptr  set-rear-ptr!))

(define (make-queue) (%make-queue '() '()))

コンストラクタ、アクセサ、モディファイアが一度に定義され、関係がより明白だ。

ちなみに、残念ながら R7RS の define-record-type はデフォルト値を指定して要素を初期化する機能がないのでここでは二段階に分けたが、 R6RS の define-record-type はより高度な機能を持っていてこれを解決できる。

レコードの使い難さ

Scheme では、取り扱えるオブジェクトの一部をデータ値 (datum value) と呼んでいる。 仕様の中でこの用語を定義しているのは R6RS だけのようだが、概念的には R5RS や R7RS でも同じような考え方があるのでここではデータ値という用語を使うことにする。

データ値とは、 write 手続きで書出して read 手続きで読出したオブジェクトが書出し前の値と等しいことが保証されているオブジェクトである。 リテラル表記が可能な値と考えてもよいだろう。

具体的には

  • 真偽値
  • 数値
  • 文字
  • シンボル
  • 文字列
  • 以上を要素とするようなリストやベクタ

といったようなものだ。

Scheme の仕様上はレコードはデータ値ではない。 read で復元できないだけで、処理系によっては write で要素まで表示してくれることもあるが何も保証はないので移植性のある形でレコードを表示したいのであれば各要素を取出して表示する必要がある。

例えばこのようなコードを実行してみよう。

(import (scheme base) (scheme write))

(define-record-type alt-pair (kons x y) kons?
  (x kar set-kar!)
  (y kdr set-kdr!))

(write (kons 1 2))

Gauche はこのように表示する。

#<alt-pair 032a4660>

オブジェクトを一意に識別するアドレスを表示するだけでその内容までは表示してくれない。 Sagittarius でも同様である。

Foment は要素まで表示してくれる。

#<(alt-pair: #x9e0730 x: 1 y: 2)>

プログラムの完成段階であればともかく、試行錯誤の段階ではデータ構造を write ひとつで書出せると実に楽なので、レコードよりもリストを使ってしまいがちになる。

マクロで作るレコードもどき

データ値にレコードの構文をかぶせるマクロを作るという方法を私は考えた。

以下の実装による define-record-type は R7RS の define-record-type と同じ構文であるが、コンストラクタが生成するオブジェクトの実態はベクタである。 ベクタはもちろんデータ値なので write で内容を表示することが出来る。

レコード型を区別するためにベクタの最初の要素にリストを入れているが、これはレコード型を定義するときに生成するリストと eq? 的に等しいか否かで区別するので一旦 write で書き出しだものを read しても元と同じではないということには注意する必要がある。 あくまでレコードを簡単に表示できるので便利だというだけのものだ。

(define-library (vrecord)
  (export define-record-type)
  (import (except (scheme base) define-record-type))

  (begin

    (define (make-accessor tag count)
      (lambda(record)
        (if (and (vector? record)
                 (< 0 (vector-length record))
                 (eq? (vector-ref record 0) tag))
            (vector-ref record count))))

    (define (make-modifier tag count)
      (lambda(record obj)
        (if (and (vector? record)
                 (< 0 (vector-length record))
                 (eq? (vector-ref record 0) tag))
            (vector-set! record count obj))))

    (define (make-predicate tag)
      (lambda(record)
        (and (vector? record)
             (< 0 (vector-length record))
             (eq? (vector-ref record 0) tag))))

    (define-syntax duplicate-check
      (syntax-rules ()
        ((_) #f)
        ((_ p r ...)
         (letrec-syntax
             ((foo (syntax-rules (r ...)
                     ((_  r) (syntax-error "duplicated field-name" p))
                     ...
                     ((_  x) (duplicate-check r ...)))))
           (foo p)))))

    (define-syntax contained-in-fields?
      (syntax-rules ()
        ((_ fs (f ...)) #f)
        ((_ fs (f ...) i . is)
         (let-syntax ((foo (syntax-rules (f ...)
                             ((_ f) (contained-in-fields? fs fs . is))
                             ...
                             ((_ g) (syntax-error "unrecognized field-name" i)))))
           (foo i)))))

    (define-syntax make-constructor
      (syntax-rules ()
        ((_ tag (a ...) (i ...) ())
         (lambda(i ...) (vector tag a ...)))
        ((_ tag (a ...) (i ...) (f fr ...))
         (let-syntax ((foo (syntax-rules (i ...)
                             ((_ tag t e i is r) (make-constructor tag t is r))
                             ...
                             ((_ tag t e j is r) (make-constructor tag e is r)))))
           (foo tag (a ... f) (a ... (if #f #t)) f (i ...) (fr ...))))))

    (define-syntax foo
      (syntax-rules ()
        ((_ n tag (pn ...) (pb ...) idx)
         (define-values (pn ...)
           (let ((tag (list 'record 'n)))
             (values pb ...))))
        ((_ n tag (pn ...) (pb ...) idx (fx ax) r ...)
         (foo n tag (pn ... ax) (pb ... (make-accessor tag idx)) (+ 1 idx) r ...))
        ((_ n tag (pn ...) (pb ...) idx (fx ax mx) r ...)
         (foo n tag (pn ... ax mx)
              (pb ... (make-accessor tag idx) (make-modifier tag idx))
              (+ 1 idx)
              r ...))))

    (define-syntax define-record-type
      (syntax-rules ()
        ((_ n (c i ...) p (f a m ...) ...)
         (begin
           (duplicate-check f ...)
           (duplicate-check i ...)
           (contained-in-fields? (f ...) (f ...) i ...)
           (foo n tag (c p)
                ((make-constructor tag () (i ...) (f ...))
                 (make-predicate tag))
                1 (f a m ...) ...)))))
    ))

レコードもどきを使ってみる

では作ってみたレコードもどきを使ってみる。

(import (except (scheme base) define-record-type)
        (scheme write)
        (vrecord))

(define-record-type alt-pair (kons x y) kons?
  (x kar set-kar!)
  (y kdr set-kdr!))

(let ((k (kons 1 2)))
  (write k)
  (newline)
  (write (kons? k))
  (write (kons? (cons 1 2)))
  (write (kar k))
  (write (kdr k))
  (set-kar! k 3)
  (write (kar k))
  (newline)
  (write k))

この実行例を実行した結果は以下のように表示されるはずだ。

#((record alt-pair) 1 2)
#t#f123
#((record alt-pair) 3 2)

R7RS の define-record-type と干渉しないように import のときに except を指定することを忘れないように気を付けて欲しい。

ちなみに、ほんの少しだけ修正すれば R5RS でも使えるはずなので R7RS 用のコードを R5RS に移植するような場合にも利用できるだろう。

Document ID: 42a50ddec93f9d61b6d6e6736487d0b0