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

破壊!

プログラミング言語 Scheme は多くの LISP 系言語がそうであるようにリスト操作を多用する。 SRFI-1 では便利なリスト操作手続きが定義されていているのだが、 RnRS の考え方とは異なる部分があり、そこで初心者がつまづくことがあるようだ。 以下のような事例で (C B A) が出力されることを期待してしまうといったようなことだ。

(import (scheme base)
        (scheme write)
        (srfi 1))

(define x (list 'A 'B 'C))
(reverse! x)
(write x)

実際には SRFI-1 によればこのコードの出力結果は規定されない。 参照実装通りの実装であれば (A) になるだろう。

Scheme の一般的な習慣としては名前の末尾にエクスクラメーションマークが付いている構文や手続きは破壊的な操作を行うのだが、 SRFI-1 においては破壊という言葉を使わずに線形更新 (linear update) という言葉を定義して当て嵌めている。 これは入力されたオブジェクトを壊して再利用する可能性があることを示すもので、どのように再利用されるか、あるいは再利用されないのかは規定されていない。 reverse! の結果はあくまで返却値であり、入力したオブジェクトはもはや利用してはならないということを意味する。

R5RS や R7RS ではそれぞれ以下のような命名規約が示されている。

規約により、割り当て済みの場所 (3.4 節参照) に値を格納する手続き名は通常の場合“!”で 終了している。 こういった手続きを変異手続き (mutation procedure)と呼ぶ。規約上、変異手続きの返す値は未規定である。

! は,以前に割り当てられた場所の中へ値を格納する手続き (3.4 節参照) の名前の最後の文字である。このような手続きは変異手続き (mutation procedure) と呼ばれる。 変異手続きが返す値は未規定である。

これらの規約に従うなら、名前の末尾がエクスクラメーションマークであるような手続きは破壊的な操作を行い、返却値が規定されない以上はその破壊的な操作こそが期待する動作であることを意味する。 この意味で考えていると reverse! の挙動につまづいてしまう。

このように SRFI のいくつかは RnRS と、あるいは他の SRFI と一貫していないこともあるので注意が必要だ。

Document ID: 81b51a480de15de54c3ce139310dcca6

万能な HTML

文章を記述するために HTML は万能の選択肢だ。 必要であれば JavaScript を用いることでかなり複雑な描画も可能であるし、動きのある画像も作ることが出来る。 数式を記述するための語彙群である MathML に対応したブラウザが一向に出てこないが JavaScript で書かれたライブラリ MathJax を導入することで MathML を利用することが出来るどころか TeX 風の記法も可能になる。 (というより数式は MathML よりも TeX 風記法で書かれることの方が多いようだ。)

しかしブラウザを通さないで見たとき、視覚的にマークアップは邪魔だ。 HTML タグを使う記法は冗長なので書くのが面倒くさいという欠点もある。 そのために簡易的な記法 (軽量マークアップ言語) がいくつも生み出された。 今では Markdown が最も有名だが ReStructuredText, Textile, AsciiDoc, Creole といった記法がよく知られており、各種ブログやウィキのサービスはこれらの他に独自の記法を持っている場合もよくある。

さて、軽量マークアップ言語は軽量というだけあって HTML のような万能を目指さないかわりに記法が簡易的になるようにするというのが基本的な理念だろう。 たとえば行頭に # を入れて見出しにする記法などは、それをレンダリングしなくても見出しらしく見えて視覚的にも自然である。

高度な機能を捨てることで簡易さを目指したはずなのに、やはり物足りなくなってくるのか拡張仕様が現れてもいる。 軽量にすると決めたのならある一定以上はサポートすべき範囲のものではないとして捨てればよいのだ。 後付けでこれもいる、あれもいると加えてしまったばかりに不格好になってしまっている。 そんなわけで、近頃の私は、いっそ最初から HTML で書くのが好ましいと思っている。

Document ID: 7645b5a12c5982e78505b1ae87b4313d