折角 Typed Racket を使っているので Digit 型を定義することにしました。

手続きに整数のリストを渡すインターフェースにすると、 リストの要素が0から9までの整数になっていない場合には、 入力としては不正なわけです。

ただ、実際プログラム書いていてこういう細かいのをエラーにするのは結構面倒だし費用対効果的に微妙となりがちだと思うのですが、 Typed Racket だと気軽に型で入力の制限が可能です。

入力値を型で制限しておくと、入力された整数が0から9までの範囲にあるという信頼できる前提にでき思考が軽くなってよいと感じます。

以下のように型定義をしました。

(define-type Digit (U 0 1 2 3 4 5 6 7 8 9))
(define-predicate digit? Digit)

かなりごり押し感のある型定義ですが、 Digit は10個しかないのでいいとしましょう。 これで Digit を普通の整数として扱いつつ、0から9までの整数に限定した型が用意できました。

また、 digit? 述語も定義しています。 この述語で分岐することで Digit かどうかを判定できます。

Luhn アルゴリズムの検証をする際には、 番号の列を一度を Luhn 型の構造体に変換してから扱うことにしました。

Luhn 構造体は次のように定義しています。

(struct luhn ([rev-digits : (Listof Digit)])
  #:type-name Luhn)

rev-digits というフィールドのみを持った構造体です。 中間構造としては反転したリストを持った方がやりやすいのでそうしています。

list->luhn は以下のようになっています。

(: list->luhn (-> (Listof Digit) Luhn))
(define (list->luhn lst)
  (luhn (reverse lst)))

string->luhn は、文字列に数字以外が含まれていた場合に対処するため少し複雑になっています。 文字が数字でない場合に #f を返すようにしているだけではあります。

(: string->luhn (-> String (Option Luhn)))
(define (string->luhn str)
  (call/cc
   (lambda ([return : (-> False Nothing)])
     (luhn
      (for/fold ([rev : (Listof Digit) '()])
                ([c (in-string str)])
        (cond [(digit-char->digit c) => (lambda (d) (cons d rev))]
              [else (return #f)]))))))

(digit-char->digit の掲載は省略、GitHub で公開している実装の方を参照してください)

luhn-valid? は以下の定義になっています。

(: luhn-valid? (-> Luhn Boolean))
(define (luhn-valid? lhn)
  (zero? (modulo (luhn-sum lhn) 10)))

非公開の手続きである luhn-sum メソッドでチェックサムを計算して、10 で割り切れるかを確認します。

luhn-sum は次のような感じです。

(: luhn-sum (->* (Luhn) ((Listof (U 1 2))) Natural))
(define (luhn-sum l [scale-list '(1 2)])
  (for/sum : Natural
           ([d : Digit (luhn-rev-digits l)]
            [scale : Natural (in-cycle scale-list)])
    (sum-of-digits (* d scale))))

luhn アルゴリズムでは、番号の右端から 1, 2, 1, 2 … のサイクルの列を掛け合せた値を使います。 この計算をするのには、事前にリストを反転させておいた方がいいため、 luhn 構造体に入っている反転済みのリストを使っています。

番号の各ディジットと scale-list のサイクルを掛けた後、 2桁になる場合は1桁目と2桁目を加算した値を使います。 この計算は sum-of-digits 手続きで実装しています。

(: sum-of-digits (-> Natural Natural))
(define (sum-of-digits n)
  (define-values (q r) (quotient/remainder n 10))
  (if (< q 10)
      (+ q r)
      (+ r (sum-of-digits q))))

この実装では、任意の自然数に対して sum-of-digits を求められるようにしているのですが、 0 から 19 までの整数に対してであれば、 n が 9 より大きい場合に 9 を引くという方法でも求められます。 これは、 Wikipedia の Luhn アルゴリズムのページに記載されていた実装でこの事実が使われているのをみて知りました。 たしかにそうなのですが、 sum-of-digits という名前を付けて抽象化した以上は 0 から 19 までに限定するのはいかがなものかと思ったので任意の自然数に対して動作するように実装しています。

luhn-add-check-digit の実装は以下の通りです。

(: luhn-add-check-digit (-> Luhn Luhn))
(define (luhn-add-check-digit l)
  (luhn (cons (calculate-check-digit l)
              (luhn-rev-digits l))))

これをみると、やはり反転したリストを中間構造として使うのがよさそうです。 仮に反転していない場合は (append (luhn-digits l) (list (calculate-check-digit l))) のようにしないといけないわけで、要素を一つ追加するのにリストを構成する pair を全部更新するのはちょっとなあという気持ちになると思います。

(: calculate-check-digit (-> Luhn Digit))
(define (calculate-check-digit l)
  (let ([sum (luhn-sum l '(2 1))])
    (assert (modulo (- 10 (modulo sum 10)) 10)
            digit?)))

先程紹介した luhn-sum を再度使っています。 追加するチェックディジットを計算するには、 チェックディジット部分を飛ばしてチェックサムを計算した際に、 何を足したら10で割り切れるかというのを計算する必要があります。

チェックディジットを飛ばした場合のチェックサムを計算するために luhn-sum に '(2 1) を渡しています。 こうすることで、右端から 2, 1, 2, 1… で掛け合わせた場合のチェックサムが手に入ります。 ((cons 0 _) をしてから、 luhn-sum に渡してもよかったのですが、無駄にpairを作るのが嫌だと思ったのでそうはしていません)

あとは assert の部分についてなのですが、 これは (modulo _ 10) の結果が Natural 型に広がってしまうために書いています。 仮に (digit? (modulo _ 10)) が偽の場合は実行時エラーになります。しかし私は (modulo _ 10) の結果は常に Digit だと知っているので assert を書くことにしました。

Typed Racket には実験的機能として Dependent Function Type というのがあり、もしかすると 0<=n<=9 のような n をうまく扱うことができるのかもしれないのですがよく分かっていないのと、それ以前に実験的機能という問題があるのでこのあたりの可能性については深入りしないことにします。

• 型がつくおかげで細かいエラーの可能性について考慮が不要になってよかった
  • 「Digit 以外の整数が渡ってくることがない」など
• Digit 型を定義できること
  • 0から9までの整数を表現する型を定義できるのは珍しい
• Racket の for/fold や for/sum などの繰り返し構文が便利で分かりやすい
• 簡単なテストを実装のそばに書けるのが嬉しい
  • module+ 構文を使うと実装を書いた後にすぐテストをかけて楽
• 型が付いているのでインターフェースの変更時に、試しに動かさなくても壊れている部分を型エラーで全て把握できる
• Natural 型が便利、負の整数の可能性を考慮しなくてよいのは最高

• Racket に依存すること
  • 当然他の Scheme 処理系との互換性はない
• 型注釈しないといけない部分としなくてよい部分の違いが分かりにくい場合がある
• Maybe Boolean 的な構造が欲しい場合に困ると思った
  • 最終的な実装ではこの型が不要になる設計にしたが、実装中は悩んでいた
  • 詳細は次の「Typed Racket での失敗の表現をどうするかについて」で言及する

文字列を渡して、luhn アルゴリズムで検証する手続きを実装すると考えてみましょう。

この手続きはどういう型にするのがいいでしょうか。 文字列に数字以外がある場合と、 luhn アルゴリズムで検証した結果誤りがあった場合では、 失敗の意味合いが異なってきます。 前者はプログラムが期待していない入力値エラーという意味で、 後者はluhnアルゴリズムの結果として誤りを発見したという意味です。

luhn アルゴリムで検証することが主目的であれば、 文字列に数字以外がある場合はその計算の目的を果たす前に失敗したということなので、計算の失敗を表現しないといけません。

シンプルに例外を放ってしまうというのも一つの選択肢です。 Racket には Java の throws みたいな機能がなく、 手続きがどの例外を放つ可能性があるのかということを適切に把握できるわけではないためあまり使いたくない気がしています。

例外を使う場合はドキュメント作成の負荷が上がるし、 利用者にドキュメント参照の負荷をかけることになるのでなるべく避けたい気がします。

Haskell などで採用されているのと同じ Maybe 型を定義するという方法です。

Racket には代数的データ型はない(と思うの)ですが、次のように構造体を定義すれば Maybe をエミュレートできます。

(struct (A) just ([value : A])
  #:type-name Just)
(struct none ()
  #:type-name None)
(define-type (Maybe A) (U (Just A) None))

これなら (Maybe Boolean) という構造を作れますし、Maybe をネストすることも可能です。

しかし、前述したような cond の => のような Racket 標準にある便利な構文が使えるわけでもないので、 Racket の標準的な実装方法から大きく外れる問題があります。 これをうまく扱うライブラリが適切に整っていないと別に便利とはいえないですし、揃っていたとしても Typed Racket 標準から大きく外れて特定のライブラリに深く依存する感じになるのが嫌です。

失敗継続を使うという方法があります。 この方法で実装する場合はこんな感じになります。

(: luhn-string-valid? (All (A) (-> String (-> A) (U A Boolean))))
(define (luhn-string-valid? str fail)
  (cond [(string->luhn str) => luhn-valid?]
        [else (fail)]))

失敗した場合に継続する処理を、 ライブラリのユーザー側で決めてから luhn-string-valid? を使うという方法です。 ちょっと気になるのは、 Boolean を返すとは限らないのに ? を使うのっていいのだろうかというところで少し微妙な感じがします。

以下のように型を変更すれば、失敗した場合は (fail) が値を返さないようにすることを利用者に強要することも可能なのですが、 失敗継続に何を渡すかには好みがある気がしていて、戻り値の型を Boolean にするためだけにこういった無理強いをするのはどうなのかなと思います。

(: luhn-string-valid? (-> String (-> Nothing) Boolean))
(define (luhn-string-valid? str fail)
  (cond [(string->luhn str) => luhn-valid?]
        [else (fail)]))

この場合は失敗継続は値を返してはならないので、 fail 手続きの中で例外を発生させるか、 call/cc で外に脱出させるかといったことを利用者に強制することが可能です。

しかし、この方法でも値を返さないことがあるのに述語というのはおかしいので、そんな副作用のある変な述語は述語じゃないということでやはり名前から ? は取った方がいいような気がします。

これは、今回の luhn モジュールで採用した戦略です。 luhn-string-valid? のような Boolean を返すが失敗する可能性があるという種類の手続きをそもそも定義しなければ問題は解決したといえます。

結局、失敗する可能性のある Boolean を返す手続きというのは、 なんらかの意味で副作用のある変な述語であり、 そもそも何か設計がおかしいのかもしれません。

計算結果の構造体を定義して、 その結果の構造体に対しての述語手続きを用意する方法の方がうまい設計だといえるのかもしれないです。

いつでもこの方法が取れるかについてはよく分からないのですが、 この方法を採用した結果、設計がより綺麗になるのであれば、基本的にはこれでいいのかなという感じがします。

まず再帰的なデータ構造について本記事で扱うものを紹介します。

綺麗な再帰手続きは、 計算の手順を記述したものとしてではなく、 宣言的な定義として読めます。

たとえばリストを連結する手続きを Scheme で書いてみましょう。

(define (my-append lst1 lst2)
  (if (not (pair? lst1))
      (if (null? lst1)
          lst2
          (error "my-append: 入力は真リストでなければなりません" lst1))
      (cons (car lst1)
            (my-append (cdr lst1) lst2))))

この定義では lst1 の値によって3つの場合に分けて、 それぞれ (my-append lst1 lst2) をどのように置き換えるかということを記述しています。

ここでは、二つの式「 x と y が等しい」を (equal? x y) 、「 p ならば q 」を (implies p q) と表現することにします。

;; 1. lst1 がペアでなくかつ lst1 が null? (空リスト)場合
;; (null? lst1) より lst1 は '()
(implies (and (not (pair? lst1))
              (null? lst1))
         (equal? (my-append '() lst2) lst2))

;; 2. lst1 がペアでなく空リストでもないときはエラー
;; lst1 はリストでないため入力エラーとする
(implies (and (not (pair? lst1))
              (not (null? lst1)))
         (equal? (my-append lst1 lst2)
                 (error "my-append: 引数は真リストでなければなりません" lst1)))

;; 3 lst1 がペアのとき、(my-append lst1 lst2) と (cons (car lst1) (my-append (cdr lst1) lst2)) は等しい
(implies (pair? lst1)
         (equal? (my-append lst1 lst2)
                 (cons (car lst1)
                       (my-append (cdr lst1) lst2))))

1番目と2番目は自明です。 1番目は空リストと他のリストを連結した場合は変化しないということを意味しています。 2番目は lst1 がリストではなかった場合です。 この場合は引数がリストであるという前提に違反しているのでエラーでよいでしょう。

問題は3番目です。 equal? の部分が真でよいのか考えてみましょう。 3番目のケースは lst1 を先頭の要素 (car lst1) と 残りのリスト (cdr lst1) に分割しています。 私が想像しているリストの連結では lst1 がペアなら (my-append lst1 lst2) もペアであるです。

そのため、両辺を car, cdr で二つに分けてそれぞれ考えましょう。

;; 1. lst1 と lst2 を連結したとき、最初の要素は lst1 の最初の要素と等しい
(implies (pair? lst1)
         (equal? (car (my-append lst1 lst2))
                 (car lst1)))

;; 2. lst1 と lst2 を連結したとき先頭を除いたリストは
;; lst1 の先頭を除いたリストと lst2 を連結したものと等しい
(implies (pair? lst1)
         (equal? (cdr (my-append lst1 lst2))
                 (my-append (cdr lst1) lst2)))

以上の二つですが、 (my-append lst1 lst2) が「リストの連結」 を意味しているのであれば、その性質から真であるべきです。 このように定義は意図した通りであると確認できました。

しかし、再帰的定義では単に書き換えが意図したものであれば、 いいわけではないことに注意が必要です。 再帰手続きはうまく定義しないと計算が終了しない可能性があります。 計算が終了しないのは致命的なバグですので、 停止することを確認する必要があります。

これを確認するには手続き内の全ての再帰呼び出しについて確認する必要があります。 今回は (my-append (cdr lst1) lst2) にフォーカスするとよいです。 my-append の一つ目の引数では、 リストの要素数を一つ減らしていることに注目してください。 リスト要素数は減少を繰り返すといずれ必ず長さの最小値である0に到達します。 長さが0のリストは pair? ではなく pair? でない場合は再帰呼び出しをしないため、 my-append は必ず停止します。

以上のように停止性についての考慮は必要ではありますが、 それさえ確認ができれば再帰手続きの正当性を確かめるのに必要なのは、 それぞれのケースにおいて式の書き換えが妥当であるということだけです。

計算量に対する考察も必要ではあるのですが、 この式が何やっているかという点については、 式を見れば分かるという程度の性質のものであり、 計算の流れを追いかけないと分からないというものではないのです。

これこそが再帰による記述の強みです。 再帰は理解が容易で検証が簡単なプログラムの書き方なのです。

「末尾再帰への書き換え」 は再帰アルゴリズムの優れた性質を大きく損なうし、 計算効率上の利点もないケースが多くあるので、 必要ないならやめた方がいいというのが本記事の主張です。

「末尾再帰への書き換え」と言われますが、 やっていることはループへの書き換えです。

Scheme には名前付きletという構文があり、 以下のようにも書けます。

(define (my-map-tail proc lst)
  (let loop ((lst lst)
             (acc '()))
    (if (not (pair? lst))
        (reverse acc)
        (loop proc
              (cdr lst)
              (cons (proc (car lst))
                    acc)))))

これもまた末尾再帰なのですが、 ほぼほぼループ構文みたいな記述になります。 なお、名前付き let を使って末尾再帰でない再帰手続きを書くことも可能なので そこは注意してください。

さらに、Scheme の do という繰り返し用の構文を使って 書くこともできます。

(define (my-map-tail proc lst)
  (do ((lst lst (cdr lst))
       (acc '() (cons (proc (car lst))
                      acc)))
      ((not (pair? lst)) (reverse acc))))

Scheme では do も実態としては末尾再帰をしているのですが、 こちらはより繰り返し機能にフォーカスした構文となっています。

これら全部同じです。 末尾再帰への書き換えとかいっていますが、 ようするにループへの書き換えです。 末尾再帰への書き換えの実態はループへの書き換えです。

繰り返しよりも末尾再帰の方が好きなんだ！ と思う方もいるかもしれませんが、 残念ながらこの使い方においてはループと同じです。

末尾再帰でないフィボナッチ数の計算を

(define (fib n)
  (cond ((<= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1))
                 (fib (- n 2))))))

として、末尾再帰版を

(define (fib-tail n a b)
  (if (<= n 0)
      a
      (fib-tail (- n 1) b (+ a b))))

とするものがあります。

一目瞭然ですが、両者では計算方法がまったく違います。 そもそも fib は木構造的な再帰をしているのに、 fib-tail は繰り返し処理になっています。

このように全然違うものについて比較して、 末尾再帰の方がよいとするのは 本記事の主題とは関係のない話です。

これは Lisp のリストに慣れていないとやってしまう 可能性のある大きな間違いです。 これは、アルゴリズムが致命的な欠陥を抱えているという問題であり、 「末尾再帰に書き換える」という話ではありません。

(define (heavy-reverse lst)
  (if (not (pair? lst))
      '()
      (append (heavy-reverse (cdr lst))
              (list (car lst)))))

この定義は論理的には問題がなく、 意図した通りに lst を反転したリストを求めます。

しかし、リストの特性を考慮すると致命的な欠陥となります。 再帰手続きの帰納部に (append x (list e)) という構造がの式があるのはとてもよくないです。

cons は一つペアを作る手続きなのに対し、 (append x y) は (legnth x) 個のペアを作る操作です。 この操作を再帰的に適用してまうと、 大量のペアを作成することとなり大変なことになってしまいます。

Scheme のリストは左側に要素を追加するのと右側に要素を追加するのは、 まったく異なるので気をつけましょう。 右に要素を追加したいと思ったら、 回避する方法がないか検討することをおすすめします。

1千万回のネストでスタックオーバーフローすると仮定して、 テストして問題ないか検証しました。

下記のコードを実行して正常に返ってくるかを確認します。

(let f ((i 10000000)) (if (= i 0) 0 (+ i (f (- i 1)))))

OS は GNU Guix System です。 検証時の ulimit -s の値は 9788 でした。

$ ulimit -s
9788

以下の通り、C言語のコードでは 100万回のネストでスタックオーバーフローしたため、 Scheme での検証では余裕を持って1000万回のネストに耐えられるかを検証します。

$ cat sum.c 
#include <stdio.h>
#include <stdlib.h>

long long sum(long long n) {
  if (n <= 0) {
    return 0;
  } else {
    return n + sum(n - 1);
  }
}

int main(int argc, char **argv) {
  long n = atol(argv[1]);
  printf("result: %ld\n", sum(n));
  return 0;
}
$ guix shell gcc -- gcc sum.c -o sum
$ ./sum 100000
result: 5000050000
$ ./sum 1000000
Segmentation fault
$ 

検証した処理系についてですが、 2024/12/25 現在で GNU Guix で簡単にインストールして動かすことのできた処理系に限定して調査しました。

こちらのリストは今後更新していこうと思います。

それぞれの検証結果としては以下のようになりました。 スタックオーバーフローしないものについて、 ドキュメントでの記載があるか調べたのですが、 私が調査した限り見つけられなかったものは「不明」としています。

以上から、Scheme では深くネストしても スタックオーバーフローしない処理系が多くあることを確認できました。

ドキュメントでの記載が確認できている状態であれば、 気にすることなく再帰手続きで実装しても問題なさそうです。

Emacs とは拡張性とカスタマイズ性に 優れた自由なテキストエディターです。

私は日常でも仕事でも常に Emacs を使っており、 メモ、日記、プログラミング、コンピュータの設定管理、タスク管理、 テキスト Web ブランジング、メール、RSS の購読、 カレンダー管理、表計算、お金の管理など さまざまなことのために Emacs を利用しています。

そして、もちろん Web サイトの作成も Emacs でしているので、 その方法について説明します。

Emacs の org-mode は org という Emacs で扱えるテキストファイルの文書フォーマットを扱うモードのことで、 文書作成、メモ作成、タスク管理、スケジュール管理、リンク管理、表計算、 文書内でのコード実行など、これまたいろんなことができます。

Emacs には org 形式の文書を html に変換して export する機能があるので、 この機能を活用して HTML を生成します。

最初の投稿は 2022/02/18 (火)のこんにちは、世界! という記事です。 この投稿で紹介しているように初期は GNU Guile 製の Haunt という静的サイトジェネレータを使用していました。 当時は Web 記事を GitLab で管理をしていて、 www-tojo-tokyo というリポジトリで管理していました。 サイトにこなくてもリポジトリの posts ファイルの中身を見れば記事が読めるという状況になっていたようです。

Haunt は大変優れた静的サイトジェネレータです。 Haunt では公式では Texinfo, Skribe, CommonMark の形式をサポートしているのですが、 Reader を追加することで新しい形式を追加することができます。 私は org-mode の形式を pandoc で変換する方法追加していました(実装)

最初は pandoc での変換結果に満足していたのですが、 後に Emacs の HTML Export 機能で出力される HTML と、 pandoc で生成される HTML の違いに不満を抱くようになりました。 まず Emacs にはソースコードに色を付ける機能が内包されているのですが、 pandoc で HTML に変換すると Emacs が付けていた色の情報は失なってしまいます。 Emacs の機能で HTML エクスポートをすれば適切に色を付けてくれるのでその機能を使いたいと思うわけです。

(define (factorial n)
  (if (<= n 0)
      1
      (* n (factorial (- n 1)))))

また、 org-babel という機能で文書内のソースコードを実行して、実行結果を文書に含めてくれる機能があるのですが、 エクスポートしたHTMLにコードを含めるのか実行結果を含めるのかを制御する機能があったり、 HTMLのHEADに追加特定のHTMLタグを追加することができたりと、EmacsでHTMLを出力した方が便利なところがたくさんあるのです。

Emacs のエクスポート機能を使うのであれば、 Haunt に依存しなくても Emacs の機能のみを使えばいいのではないかと思うようになりました。

そのため、2022/03/04(金)の Web サイトをリニューアルしました にて、 静的サイトジェネレータを Haunt から GNU Emacs に変更しました。

このときのリニューアルでは Haunt 時代から不便になった部分も多くあったので、 2022/11/19(土) のWeb サイトをリニューアルしてタグを追加した のリニューアルで仕組みを大幅に改善しています。

この記事では 2022/11/19(土)以降の私のサイトの仕組みについて紹介します。

この程度のことができない人にはもはや何もできないのではないかという疑いが発生しますが、 ファイルを作成するというのは意外と簡単ではありません。 ファイルを作成にするには以下の作業が必要です。

• ファイル名を決めないといけない
  • ファイル名はパーマリンクになるので真面目に考えることになります
  • 変更したい場合、ファイル名を変更しないといけない
• 前の記事を確認するのに別のファイルを開かないといけない
  • 前例踏襲をしたいときに困る
  • posts/ 以下のファイルを選択しなければならない
    • 直近の記事を参考にしたいが、どれが直近だか分からない

このように posts 以下にファイルを新規作成するのは面倒なのです。

記事を書いたら、一覧ページに記事へのリンクを張らなければなりません。 これもまた面倒な作業ですし、リンクを間違える可能性もあります。

Emacs の org-html-export では、 相対リンクを書いたときに、 リンクが先ファイルがない場合はエラーとなり失敗してくれるという機能があります。 そのため、間違えて 404 Not Found になってしまうリンクを書いてしまうリスクはないのですが、 それでも過去記事からコピペして変更せずに過去記事にリンクを張ってしまうというリスクが残ります。

直感的にもこの作業が本質的にやらないといけないことだとは思えません。

しかし、スクリプトうんぬんの前にこの形式の posts.org を書くこと自体が面倒くさいのではないか？という問いがあります。 この問題は Emacs の org-mode の、 org-capture という機能を使うことで解決します。

Emacs に以下のような設定をします。

(global-set-key (kbd "C-c c") 'org-capture)

(setq org-capture-templates
      `(("w" "新しい記事" entry (file "~/www/posts.org")
         "* %^{TITLE}
:PROPERTIES:
:FILENAME: %^{ID}
:PUBDATE: %^T
:DESCRIPTION: %^{DESCRIPTION}
:END:

%?"
         :prepend t
         :jump-to-captured t)))

この設定を反映した後に C-c c (Controlを押しながらcを押した後に単独で c を押す)と、 org-capture で記事を新規作成できます。

次のようなスクリプトを作成します。

なお、実際の私のサイトはタグ機能などをサポートしていて、複雑になっているため簡略化しています。

;; 簡単に html-escape する
(defun html-escape (str)
  (let* ((str (string-replace "&" "&" str))
         (str (string-replace "<" "&lt;" str))
         (str (string-replace ">" "&gt;" str))
         (str (string-replace "\"" "&quot;" str)))
    str))

(defun find-index-file ()
  (let ((description "私の Web サイト &&& デモ &&&"))
    (cond ((not (file-exists-p *path*))
           ;; 初回は index.org の最初の部分を作成する
           (find-file *path*)
           (insert "#+TITLE: 私のWebサイト!\n"
                   "#+HTML_HEAD: <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\"/>\n"
                   "#+HTML_HEAD: <link rel=\"stylesheet\" href=\"/static/css/base.css\"/>\n"
                   "#+OPTIONS: email:nil num:nil toc:nil\n")
           (insert (format "#+DESCRIPTION: %s\n" (html-escape description))))
          (t (find-file *path*)))))

;; 時刻から日付を取り出す
(defun strip-time (pubdate)
  (concat (substring pubdate 0 -7)">"))

(defvar *path* "./index.org")

;; posts.org を開く
(find-file "posts.org")

(let ((pt nil))         ; pt はカーソルの位置を記録しておくための変数
  ;; ファイルの最小の heading までカーソルを移動
  (org-next-visible-heading 1)
  ;; pt とカーソルの位置が同じになるまで繰り返す
  ;; 等しい場合は最後まで進んだということで処理終了
  (while (not (equal pt (point)))
    ;; いまのカーソルの位置を覚えておく
    (setq pt (point))
    (let ((link ; posts 下のファイルへのリンク
           (concat "./posts/"
                   (org-element-property :FILENAME (org-element-at-point))
                   ".org"))

          (title (org-get-heading t)) ; h1 をタイトルとする
          (pubdate (org-element-property :PUBDATE (org-element-at-point))) ; 公開日を取得
          (description (org-element-property :DESCRIPTION (org-element-at-point))) ; 詳細を取得
          )

      ;; index.org ファイルを開く
      (find-index-file)

      ;; index.org に書き込む
      (insert (format "* [[%s][%s]]\n" link title))
      (insert "#+HTML: <div class=\"info\">\n")
      (insert (format "#+HTML: <div><span class=\"date\">%s</span></div>\n"
                      (html-escape (strip-time pubdate))))
      (insert "#+HTML: </div>\n")
      (insert "\n")
      (insert description)
      (insert "\n")
      (save-buffer)

      ;; 元の場所に戻る
      (find-file "posts.org")
      (goto-char pt))
    ;; 次の h1 に移動する
    ;; 最後の場合は移動できないので動かない
    (org-forward-heading-same-level 1)))

これを実行すると…

emacs --batch -l generate-index.el 

次のような index.org ファイルが作成されます。

#+TITLE: 私のWebサイト!
#+HTML_HEAD: <meta name="viewport" content="width=device-width, initial-scale=1"/>
#+HTML_HEAD: <link rel="stylesheet" href="/static/css/base.css"/>
#+OPTIONS: email:nil num:nil toc:nil
#+DESCRIPTION: 私の Web サイト &amp;&amp;&amp; デモ &amp;&amp;&amp;
* [[./posts/article3.org][記事3]]
#+HTML: <div class="info">
#+HTML: <div><span class="date">&lt;2024-12-23 月&gt;</span></div>
#+HTML: </div>

みっつめの記事です
* [[./posts/article2.org][記事2]]
#+HTML: <div class="info">
#+HTML: <div><span class="date">&lt;2024-12-22 日&gt;</span></div>
#+HTML: </div>

ふたつめの記事です
* [[./posts/article1.org][記事1]]
#+HTML: <div class="info">
#+HTML: <div><span class="date">&lt;2024-12-21 Fri&gt;</span></div>
#+HTML: </div>

ひとつめの記事です

このように posts.org を走査することでいい感じに index.org を作成することができます。

以下のスクリプトを作成することで、 posts/ 以下に詳細記事ファイルを作成します。 (なお、実際には ox-rss で RSS を生成していたり、 タグの一覧ページへのリンクを張ったりと色々しているせいで複雑なのでここでは簡略化しています)

(find-file "posts.org")

;; html-escape する
(defun html-escape (str)
  (let* ((str (string-replace "&" "&" str))
         (str (string-replace "<" "&lt;" str))
         (str (string-replace ">" "&gt;" str))
         (str (string-replace "\"" "&quot;" str)))
    str))

;; posts ディレクトリを作成
(make-directory "./posts")

;; posts.org を開く
(let ((pt nil))          ; pt はカーソルの位置を記録しておくための変数
  ;; ファイルの最小の heading までカーソルを移動
  (org-next-visible-heading 1)
  ;; pt とカーソルの位置が同じになるまで繰り返す
  ;; 等しい場合は最後まで進んだということで処理終了
  (while (not (equal pt (point)))
    ;; いまのカーソルの位置を覚えておく
    (setq pt (point))
    (let ((title (org-get-heading t))
          (link ; posts 下のファイルへのリンク
           (concat "./posts/"
                   (org-element-property :FILENAME (org-element-at-point))
                   ".org"))
          (pubdate (org-element-property :PUBDATE (org-element-at-point)))
          (description (org-element-property :DESCRIPTION (org-element-at-point))))
      (when (file-exists-p link)
        (princ "エラー: 同じパスの記事が存在します")
        (exit 1))

      ;; 現在位置の記事全体をコピー
      (org-copy-subtree)

      ;; 記事ファイルを開く
      (find-file link)
      ;; タイルトルを挿入
      (insert (format "#+TITLE: %s\n" title))
      ;; 記事の公開日を設定
      (insert (format "#+DATE: %s\n" pubdate))
      ;; ある場合は DESCRIPTION を設定
      (when description
        (insert (format "#+DESCRIPTION: %s\n" description)))

      ;; ここで記事全体をペースト
      (yank)

      ;; ファイルの一番上に戻る
      (goto-char (point-min))
      ;; 最初の h1 に移動する
      (org-next-visible-heading 1)
      ;; プロパティ部分を削除する
      (let ((begin (car (org-get-property-block)))
            (end (cdr (org-get-property-block))))
        (kill-region begin end))
      ;; またファイルの最初に戻る
      (goto-char (point-min))
      ;; 最初のヘッダーに移動する
      (org-next-visible-heading 1)
      ;; タイトルのヘッダは不要なので削除する
      ;; :PROPETY: と :END の行も消すから3行消す必要あり
      (kill-line 3)

      ;; 投稿日を挿入
      (insert (format "#+HTML: <div class=\"publish-date-wrap\"><div class=\"publish-date\">投稿日: %s</div></div>\n"
                      (html-escape
                       (substring pubdate
                                  1
                                  (- (length pubdate) (length pubdate) 7)))))

      ;; 1段階無駄に深くなっているので、
      ;; 1段階だけ浅くする
      (goto-char (point-min))
      (let ((pt2 (point)))
        (while (not (org-next-visible-heading 1))
          (org-promote)))

      ;; 保存
      (save-buffer)

      ;; 元の位置に戻る
      (find-file "../posts.org")
      (goto-char pt))
    (org-forward-heading-same-level 1)))

これを実行すると…

emacs --batch -l generate-posts.el 

posts 下に以下ファイルが作成されます。

たとえば posts/article1.org はこんな感じです。

#+TITLE: 記事1
#+DATE: <2024-12-21 Fri 00:00>
#+DESCRIPTION: ひとつめの記事です
#+HTML: <div class="publish-date-wrap"><div class="publish-date">投稿日: 2024-12-21 Fri</div></div>

* はじめに

この記事は1つめです

* おわりに

1つめの記事でした

これ準備ができました。 スクリプトを次の順番で実行すれば、 posts.org から index.org と posts/<filename>.org を作成します。 配置された状態で org-publish を実行すれば、 site ディレクトリにWeb サイトができます。

emacs --batch -l generate-index.el 
emacs --batch -l generate-posts.el 
emacs --batch -l publish.el -f publish-www

これで完成です。

私のサイトはこんな感じで、 Emacs を静的サイトジェネレータとして利用し、 サイトを作っています。

詳しくは説明しないですが、 私のサイトは VPS で GNU Guix System という OS を動かしているサーバーの nginx で配信しています。

AWS で S3 と CloundFront を使うなどをすればもっと安く運用できるというのはそうなのですが、 個人的な心情として趣味で AWS を使いたくないというのがあります。 私は GNU Guix System が大好きであり、サーバーメンテナンスすること自体が趣味ということもあるので仕方ありません。 (といっても、個人的なデータ置き場としてS3 は活用していますが…)

また、私の Web サーバーは別のサイトへのリバースプロキシをするとか、Certbot で複数のドメインのSSL証明書を管理するというような大切な仕事もしているので、一概に高いとは言い切れないところがあるわけです。

外形監視には UptimeRobot を使っています。 また、一応 Zabbix サーバーの監視対象となっていて、 ディスク使用率とか CPU/メモリの使用率なども監視しています。

デプロイは私の git サーバーに push すると、 CI が回ってに自動的にデプロイされるようになっています。

main ブランチに push すると記事が公開され、 その他のブランチに push するとテスト環境に記事が公開されます。

git push で自動的に記事が公開されると、とっても快適なのでこういう感じにするのはおすすめです。

CI は Laminar CI というのを使っていて、 git のフックを起点にデプロイを実行しています。 CI サーバーで Emacs をバッチ実行して、 Web サーバーに rsync してデプロイまでしています。

Emacs でバッチ実行していると思うと面白いですね。

自分はいままで Xfce4, LXDE, KDE, MATE, Cinnamon などの、通常の常識的な UI を提供するデスクトップを使ってきている。 タイル型マネージャとしては StumpWM や EXWM などを使っていた時期もそこそこの期間あるが、 最終的には普通のデスクトップの方が自分に馴染むと感じている。

最近になって GNU Guix System 環境でよくサポートされた Wayland 環境を使うのに GNOME を選ぶと便利という理由で再度使ってみようと考えた。

GNOME に移行し調査したところ、 Dash to Panel という拡張を入れてタスクバーを導入することで、 快適に使えると分かり一週間程度は Dash to Panel ありきで使っていたが、 さらに一週間程度経過して長期的に GNOME 本体とは異なるコンポーネントに深く依存することにリスクを感じるようになった。 Dash to Panel があればそればかり使うので、もはや GNOME ではなくて Dash to Panel を使っているような気さえしてくる。

そこで GNOME について再考し、 GNOME の設計者がタスクバーやドックが不要という姿勢を頑なに崩さないのには何か理由があるのではないかと思うようになった。 そもそも私はコンピュータの一ユーザーかつ開発者にすぎず、UI/UXの専門家ではない。 おそらくデザインについてよく学んだ人が GNOME を作っているのだろう。 それは最初はユーザーを無視した横暴だと感じていたが、専門家がそこまでそう主張するのであれば GNOME の設計は実は筋が通っているのかもしれない。

一度 Dash to Panel を外してみたがすぐに戻した。

タスクバーを押せばすぐに起動できるところを無駄にアクティビティを開くのは無駄だと思った。 いま開いている他のウィンドウを開くのにわざわざアクティブティを開くのは無駄だと思った。 すぐに切り替えたり起動したいのに、アクティビティを開くのにモーションが入るのがムカつく。 こういったストレスに耐えられなかったのである。

やはり慣れていない UI に移行するのは簡単ではないのである。

私は GNOME について学び、GNOME のコンセプトは集中にあるということを理解した。 簡単に使えることやデザインに一貫性があることなども GNOME にとって重要なコンセプトなのかもしれないが、 GNOME の選択を理解するのに最も大きな手掛りになるのは、「いましていることに集中しろ」という考え方である。

つまり、GNOME はユーザーの気が散ることを最大限避けてデスクトップを設計しているのである。 いまやっていることに集中し、他のアプリに切り替えるときに初めて「アクティビティ」を押すのだ。 集中を重視しているということを理解すると、GNOME のほとんどの決定について納得ができる。

私はコンピュータをそのようには使っていないことに気づいた。 画面には様々な情報が表示されているし、 いまの作業とは関係のないウィンドウをいくつも開いていることはよくあり、 それらを頻繁に切り替えて作業をしていた。

そう GNOME に慣れるというのは、単にその UI に慣れるという話ではなかったのだ。 コンピュータとの向き合い方を変えて初めて GNOME の価値に気づくのである。

「一つのことに集中する」この意図を理解し、私は再び Dash to Panel を外した。 GNOME の考え方に慣れていないだけで、しばらくの間使ってみて順応すれば便利なのではないかと考えたのだ。

それはまさに修行であった。

GNOME のコンセプトが「集中」であることを理解してから、おそらく一週間程度で GNOME に順応した。 もはやアクティビティを開くことに苦を感じず、タスクバーやドックが邪魔だと思うようになった。 アクティビティを開くのにかかるモーションに対してもイライラしなくなった。 むしろあのモーションが操作を心地よくしているような気さえするようになった。

GNOME に慣れたことで一つのことに集中しやすくなったような気がする。

作業画面に別のウィンドウの情報が入っていると、いまの作業の集中を妨げるきっかけになるためない。

作業画面にアプリケーションランチャーがあると、 いまの作業を中断して別のことをしたくなるきっかけになるためない。

ウィンドウを小さくしてデスクトップが画面に写ったとき、 背景に置かれているファイルが目に入ることで気が散るのでなくてよい。

自動的に表示されるシステムトレイアイコンは集中を妨げるきっかけとなる。

これは、ウィンドウに対する考え方の問題だと思われる。

GNOME にはタスクバーやドックがないため最小化する先がない。 最小化したものがどこにいったのか謎である。

最大化ボタンがないのはよく分からない。 私はスクリーンエッジ機能かキーボードショートカットのいずれかで最大化しているが、 これはたしかにちょっと分かりにくいかもしれない。

実際に届いて使ってみた感想だが、本当にノートパソコンに熱がこもるということがなくなり、手があたたまることがなくなった。 これは快適である。 私が使っているノートパソコンは下から排熱する機構になっているので、このノートパソコンを冷やすには最適な仕組みといえるだろう。

私はノートパソコンが熱くなくても普通に自身の体温によって手が温まっていることがあり、 それでも不快感を覚えるというところがあるのだが、そういったときにノートパソコンの両サイドに手を置くことによって、 簡単に手を冷やすことができるというのは隠れた利点である。

気になる可能性があるのはファンの音だろう。 人によってはうるさいと感じる方もいるかもしれない。 私としては付けっぱなしにしていればあまり気にならない程度の音かなと感じた。 風量は三段階で調節できるのだけど、一番弱いのにすると音は小さくなるのだけど回転数が少ない分低い音がでるので私はそれが気になった。 二段階目か最大の風量にすることでちょうどいい感じの騒音となり逆に気にならない感じがした。 そのため私は常に二段階目以上の強さで利用している。 自分はあまり気にならなかったが人によっては、気になるかもしれないところではあるのでそこは覚悟する必要があるだろう。

CPU の性能とかにも影響を与える要素なわけでそういった性能上の理由で困っている人にもおすすめだ。

パソコンからUSB経由で電源供給する仕様なのだが規格が USB Type-A であることには注意が必要かもしれない。 最近のパソコンは薄型への需要に答えるためなのか USB Type-C のみ採用していることも少なくない。 その場合は USB Type-A を USB Type-C に変換するアダプタが必要になる。 幸い、私のノートパソコンには USB Type-A のコネクタがあるので問題にならなかった。

Coalton は Common Lisp の可能性に限界がないことを示す素晴しい事例の一つだと思います。 研究が進んで新しいプログラミングに関する概念が生まれたときに、 開発者の努力によって追従できるプログラミング言語環境というのはそう多くないでしょう。 Common Lisp は新しい技術を創造したり適応したりすることで進化できるプログラミング言語だということを Coalton が実際に証明しています。

全ての場合を網羅できていないとき、プログラムは意図しない挙動を引き起こします。

たとえば、ステータスを見てそれぞれのステータスに対応した何らかの処理をする必要があるとします。 次のステータスを文字列に変換するコードを書いたとしましょう。

(defpackage #:manage-status
  (:use #:coalton
        #:coalton-prelude))

(in-package #:manage-status)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  (define-type Status
    Open
    Showing
    Closed)

  (define-instance (Into Status String)
    (define (into s)
      (match s
        ((Showing) "上映中")
        ((Open) "開場")
        ((Closed) "終了")))))

この後に Preparing というステータスを追加します。 このとき、Status が一つ増えたので使っている全ての箇所について漏れがないか確認する必要があります。

Coalton では網羅性チェックが機能するので、Status を網羅できていない箇所があればコンパイラが警告を出してくれます。

(defpackage #:manage-status
  (:use #:coalton
        #:coalton-prelude))

(in-package #:manage-status)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  (define-type Status
    Preparing
    Open
    Showing
    Closed)

  (define-instance (Into Status String)
    (define (into s)
      (match s
        ((Showing) "上映中")
        ((Open) "開場")
        ((Closed) "終了")))))

; caught COMMON-LISP:STYLE-WARNING:
;   warn: Non-exhaustive match
;     --> /tmp/manage-status.lisp:18:6
;       |
;    18 |          (match s
;       |  ________^
;       | | _______-
;    19 | ||         ((Showing) "上映中")
;    20 | ||         ((Open) "開場")
;    21 | ||         ((Closed) "終了")))))
;       | ||____________________________- Missing case (PREPARING)
;       | |_____________________________^ non-exhaustive match
;   
; 
; compilation unit finished
;   caught 1 STYLE-WARNING condition

条件や場合を Coalton のデータ型で表現することで、網羅性に関するバグを減らすことができます。

Common Lisp で型変換をするには coerce という関数を使いますが、残念ながらユーザーが定義したデータ型を変換するのには使えません。 そのため、Lisp では一般にユーザーが型変換をする関数を実装する場合にはだいたい次のような名前の関数を書いていると思います。

(defun foo-to-bar (foo)
  …)

(defun foo->bar (foo)
  …)

それに対し、Coalton には Into という型クラスがあり、全ての型変換を Into 型クラスのメソッド into のみで対応できます。

(define-instance (Into Foo Bar)
  (define (into foo)
    …))

CLOS のクラスと Coalton の型クラスには他にも違いがあるのですが、 ここでは Coalton の型クラスのメソッドでは戻り値の型で呼び出す実装を特定できるという点に注目します。

CLOS の総称関数を使うと引数のオブジェクトをもとにして実装を特定できますが、この仕組みでは戻り値の情報は使えません。 呼び出す実装を動的に決定している以上 coerce 関数のように変換先のヒントを与えない限りは変換関数を CLOS の総称関数の機能だけで実装するのは無理です。

;; bar クラスでディスパッチができない！
(defmethod into ((foo foo))
  …)

;; 実行時に呼び出したタイミングで foo の変換先を特定できない！
(into foo)

それに対し Coalton では into 関数の戻り値側の型をコンパイル時に知ることができるので戻り値の型から実装を特定できます。

(declare calc-bar (Bar -> …))
(define (calc-bar bar)
  …)

;; コンパイル時に型推論で (into foo) の変換先が Bar だと分かる！
(calc-bar (into foo))

CLOS の総称関数と比べて実装の特定に使える情報が一つ増えている分、ディスパッチの能力についていえば純粋にパワーアップしているといえます。

他にも Monoid や Applicative, Monad など、 戻り値の型によるディスパッチができないと表現が難しい構造がいくつもありいずれも有用です。 Coalton を導入することでこういった抽象度の高い構造を扱うことができます。

Coalton はnull安全であり、意図しないところに nil が流れついてきて実行時にエラーになってしまうという問題は生じません。

Coalton では Optional という型を使うことで結果がない可能性のある値を表現できます。 次のように Optional 型の値に対して不適切な関数を適用すると実行前に型エラーになります。

(defpackage #:optional-example
  (:use #:coalton
        #:coalton-prelude)
  (:local-nicknames
   (#:string #:coalton-library/string)))

(in-package #:optional-example)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  ;; 連想リストから要素を取り出す
  (declare get-value (Eq :k => :k -> List (Tuple :k :v) -> Optional :v))
  (define (get-value key alist)
    (do ((Tuple _ value) <- (find (.< (== key) fst) alist))
        (pure value)))

  ;; 整形する
  (declare format (Integer -> String -> String))
  (define (format k v)
    (lisp String (k v)
      (cl:format nil "~R: ~a" k v)))

  ;; 連想配列からキーで取得して整形した文字列を返す
  (define (show key alist)
    (format key (get-value key alist))))

optional-example.lisp:1:1:
  read-error: 
    COMMON-LISP:READ error during COMMON-LISP:COMPILE-FILE:

      error: Type mismatch
      --> /tmp/optional-example.lisp:26:12
        |
     26 |      (format (get-value key alist))))
        |              ^^^^^^^^^^^^^^^^^^^^^ Expected type 'INTEGER' but got '(OPTIONAL :A)'


      (in form starting at line: 11, column: 0, position: 220)

次のように Optional を考慮して修正すれば、型エラーは解消します。

(defpackage #:optional-example
  (:use #:coalton
        #:coalton-prelude)
  (:local-nicknames
   (#:string #:coalton-library/string)))

(in-package #:optional-example)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  ;; 連想リストから要素を取り出す
  (declare get-value (Eq :k => :k -> List (Tuple :k :v) -> Optional :v))
  (define (get-value key alist)
    (do ((Tuple _ value) <- (find (.< (== key) fst) alist))
        (pure value)))

  ;; 整形する
  (declare format (Integer -> String -> String))
  (define (format k v)
    (lisp String (k v)
      (cl:format nil "~R: ~a" k v)))

  ;; 連想配列からキーで取得して整形した文字列を返す
  ;; match で場合分けする場合
  (define (show/match key alist)
    (match (get-value key alist)
      ((Some value) (Some (format key value)))
      ((None) None)))

  ;; do 記法を使う場合
  (define (show/do key alist)
    (do (value <- (get-value key alist))
        (pure (format key value))))

  ;; map 関数を使う場合
  (define (show/map key alist)
    (map (format key) (get-value key alist))))

このように、nil を想定していない関数を nil に適用してしまう問題を完全に回避することができます。 Coalton を導入すれば関数の戻り値が nil である可能性を気にする手間から完全に解放されます。

<2023-12-21 木> バリデーションの実装は Result と同型の型でうまくいき、本当に必要だったものは Applicative でした。Applicative によるバリデーションは tokyo.tojo.validation にて実装しているのでよかったら見てみてください。

私が Coalton で複数の項目をバリデーションしつつ文字列から適切な型に変換をするようなプログラムを書いていたのですが、 意外とこのような処理を楽にうまく書く方法がなかなか見つかりませんでした。 試行錯誤した結果した結果、マクロを使って構文を定義した方がいいと判断して validate-with-result というプログラムを実装しました。

tojoqk/validate-with-result: Syntax `let` for delaying result in Coalton.

例として、名前、年齢、状態の3つを文字列で渡し、それぞれをパースして適切な型に変換することを考えましょう。 まずはそれぞれのパースする関数を定義します。

(defpackage #:validate-with-result-example
  (:use #:coalton
        #:coalton-prelude)
  (:local-nicknames
   (#:string #:coalton-library/string)))

(in-package #:validate-with-result-example)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  (define parse-name Ok)

  (define (parse-age x)
    (match (string:parse-int x)
      ((Some n)
       (if (<= 1 n)
           (Ok n)
           (Err (make-list "parse-age-error (negative)"))))
      ((None) (Err (make-list "parse-age-error")))))

  (define-type Status
    Sleeping
    Studying)

  (define (parse-status x)
    (match x
      ("sleeping" (Ok sleeping))
      ("studying" (Ok Studying))
      (_ (Err (make-list "parse-status-error"))))))

ここからが validate-with-result の出番です。

validate-with-result:let というマクロを使ってバリデーションを実行します。 構文は次のような感じです。

(validate-with-result:let ((<var1> <result-type-value1>)
                           (<var2> <result-type-value2>)
                           ...)
  <expr> ...)

全て Ok の場合は validate-with-result:let の <expr> 部分の式 (Tuple3 name age status) の結果が返ります。

VALIDATE-WITH-RESULT-EXAMPLE> (coalton
                               (valdate-with-result:let ((name (parse-name "john"))
                                                         (age (parse-age "28"))
                                                         (status (parse-status "sleeping")))
                                 (Ok (Tuple3 name age status))))
#.(OK #.(TUPLE3 "john" 28 #.SLEEPING))

age と status のパースに失敗した場合はそれぞれのエラーメッセージを返します。

VALIDATE-WITH-RESULT-EXAMPLE> (coalton
                               (validate-with-result:let ((name (parse-name "john"))
                                                          (age (parse-age "-28"))
                                                          (status (parse-status "playing")))
                                 (Ok (Tuple3 name age status))))
#.(ERR ("parse-age-error (negative)" "parse-status-error"))
VALIDATE-WITH-RESULT-EXAMPLE> 

こんな感じで Coalton の Reuslt 型を活用して簡単にバリデーションを実現できます。

このように Coalton でも通常の Common Lisp での開発と同じようにマクロを使うことで言語を拡張することができるのです。

lisp という構文を使うことで Coalton から Common Lisp のコードを実行できます。 たとえば次のようにして Common Lisp の format 関数を呼ぶことができます。

(defpackage #:awesome-format
  (:use #:coalton
        #:coalton-prelude))

(in-package #:awesome-format)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  (declare awesome-format (Integer -> String -> String))
  (define (awesome-format i title)
    (lisp String (i title)
      (cl:format nil "~@:R ~a" i title))))

REPL:

AWESOME-FORMAT> (coalton (awesome-format 7 "タイトル"))
"VII タイトル"

ただし、Common Lisp のコードを呼び出すときに不適切な型を返してしまうと Coalton システムの健全性を損なう可能性があるため、 Coalton の中から Common Lisp のコードを呼ぶ場合には戻り値の型に注意が必要です。

逆に Common Lisp から Coalton の関数を安全に呼ぶ方法ですが、 2023/12/10 の時点では安全に呼ぶ方法がドキュメントに記載されていません。

しかし、下記の PR がマージされているためおそらく call-coalton-function という関数を通して Common Lisp から Coalton の関数を呼ぶのが無難そうです。 Friendly interface for calling Coalton function-entry objects from CL

次のように Common Lisp のプログラムから Coalton の関数を呼び出すことができます。

(defpackage #:awesome-format
  (:use #:coalton
        #:coalton-prelude)
  (:export #:awesome-format))

(in-package #:awesome-format)

(named-readtables:in-readtable coalton:coalton)

(coalton-toplevel
  (declare awesome-format (Integer -> String -> String))
  (define (awesome-format i title)
    (lisp String (i title)
      (cl:format nil "~@:R ~a" i title))))

(defpackage #:awsome-format-cl
  (:use #:cl))

(in-package #:awsome-format-cl)

(defun show-title (i title)
  ;; Common Lisp から Coalton の関数を呼び出す
  (coalton:call-coalton-function awesome-format:awesome-format
                                 i
                                 title))