実装の経緯

近代的な関数型言語のパターンマッチやガードなどは一度その良さを覚えるとととても便利で時折恋しくなる
特にHaskellはパターンマッチ構文が豊富で魅力的
でも、プログラムはなるべくCommon Lispで書きたい
普通のLispコードの中に簡単に埋め込むことができLispと完全に融合する、遅延評価と遅延リストも扱えるちょっとだけ厳格な関数型言語が欲しい
Lispであれば、リードマクロで何でもやれる

というわけで…

業務のために構築している基礎ライブラリ群CLPGKに含ませる埋め込み関数型言語として、Common Lispで書かれたQiという結構古い関数型言語の言語コアを採用することに

言語コアとしてQiを採用する利点

Common Lispのコードを生成するコンパイラであること
原則的に非破壊を旨とするそこそこ厳格な関数型言語であること
パターンマッチ駆動かつ、ユニークなバックトラック機能を備えている
独特な静的型システムがあるものの、型システムをOFFにすることができ、値が型を持つLispスタイルも許容
小文字と大文字で始まるシンボルにそれぞれ違う意味をもたせており、視覚的に把握しやすい
Qi自体すでに完成されているので、パーザさえ書いてQiのコアにソースを流し込んでしまえばとりあえずは動かせる

Qiの言語コアで難儀する部分

Qi(正確にはQi II)の言語コアはほとんどの部分がQi自身によってCLコードにコンパイルされたものであり、つまり機械的に生成されたものです
ただでさえ他人の書いたLispコードは読みにくいと言われますが、ましてや機械の吐いたCLコードを読解して処理の流れを追っていくのはなかなか根気がいります
たとえば、こんな感じ…　おおよそ関数名から類推できるのは助かりますが

(DEFUN extract-free-vars (V7 V8)
 (COND
  ((AND (wrapper (variable? V8)) (NOT (wrapper (element? V8 V7))))
   (LIST V8))
  ((AND (CONSP V8) (EQ (CAR V8) 'rule)) NIL)
  ((AND (CONSP V8) (EQ '/. (CAR V8)) (CONSP (CDR V8)) (CONSP (CDR (CDR V8)))
    (NULL (CDR (CDR (CDR V8)))))
   (LET* ((V9 (CDR V8)))
    (extract-free-vars (CONS (CAR V9) V7) (CAR (CDR V9)))))
  ((AND (CONSP V8) (EQ 'let (CAR V8)) (CONSP (CDR V8)) (CONSP (CDR (CDR V8)))
    (CONSP (CDR (CDR (CDR V8)))) (NULL (CDR (CDR (CDR (CDR V8))))))
   (LET* ((V10 (CDR V8)) (V11 (CDR V10)))

そのままでは使えない

Qiの言語仕様は、あたりまえですがCL内で使われることを全く考慮していません
たとえばコメントが\で始まるなど、そのままの構文規則を持ち込んでしまうとEmacsのLispモードが大混乱しますので、Lispモードで不自由なく書けるスタイルにデザインを変えてやらねばなりません
また、ガードに相当するものはありますが、もっと直感的なガード構文にするためにはQiへの入力列を弄り倒す必要があります
しかし、これは言い換えれば入力列をガリガリにチューニングして、言語コアも適宜書き換えていけば、およそどんな言語にでも変身させられることを意味します

順調に進むも…

当初はユニークなQiの静的型システムを使えるように慎重に作業を進めるも、だんだんと複雑化して行くにつれ型システムが崩壊
静的型システムの導入は断念しましたが、型システムをOFFにできるQiだったため、動的言語とすることで実装のピッチが早くなったのは結果オーライでした
遅延評価と遅延リストのサポートは完全ではないものの、意外と簡単に組み入れることができました

改造しまくり弄りまくりの結果…

当初のQiからは見た目も言語機能もかけ離れましたが、かなり便利に使えています^^

準備

https://github.com/PGkids/clpgk
(ql:register-local-projects)
(ql:quickload :clpgk)
埋め込みを行うソースに次の行を入れるだけでOK
(pgk:pgk-mode)
埋め込み関数型言語のリードマクロは、(\ によって発動します
また、#~という、埋め込み言語側のシンボル等をCL側から簡単に扱うためのリードマクロも同時に定義されます

埋め込み実例

quicksort

(pgk:pgk-mode)

(flet ((\letrec qsort
         [] -> []
         [P::Xs] -> (let Smaller [A :: A<-Xs, if (<= A P)]
                         Larger  [B :: B<-Xs, if (> B P)]
                         (append (qsort Smaller) [P] (qsort Larger)))))
  (let* ((src-xs (pgk:shuffle (\|1...30)))
         (sorted (qsort src-xs)))
    (print src-xs)
    (print sorted)))

EVAL==>
(27 12 1 23 18 5 6 16 26 30 15 28 10 22 19 3 24 29 13 21 20 11 2 7 17 9 8 4 14
 25) 
(1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
 30)

遅延リストによる素数リストの生成

(\def canDivide?
      _ [] -> false
      N [P::Ps] -> (if (= 0 (MOD N P)) true (canDivide? N Ps)))

(\def getPrimes
      [N::Ns] Ps -> (if (canDivide? N Ps)
                      (getPrimes Ns Ps)
                      [N : (getPrimes Ns [N::Ps])]))

;; 無限素数リストから最初の２０個の素数を得る
(let ((lazy-primes (\\getPrimes [2..] [])))
  (print (pgk:&take! 20 lazy-primes)))

EVAL===>
(2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73)

爆速遅延たらい回し

(\def tarai
      (! X) (! Y) _,(<= X Y)  -> Y
      (! X) (! Y) (& Z) -> (tarai (&(tarai (1- X) Y Z))
                                  (&(tarai (1- Y) Z X))
                                  (&(tarai (1- Z) X Y))))

(time (format t "Answer: ~A~%" (#~tarai 12 6 0)))

EVAL===>
Answer: 12
Evaluation took:
  0.000 seconds of real time
  0.000000 seconds of total run time (0.000000 user, 0.000000 system)
  100.00% CPU
  460,313 processor cycles
  4,088 bytes consed

遅延フィボナッチ数列

(flet ((\letrec fib A B -> [A : (fib B (+ A B))]))
  (let ((lazy-fibs (fib 0 1)))
    (pgk:&take! 20 lazy-fibs)))

EVAL===>
(0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765)

埋め込みリスト内包表記

;; ここで、変数A,Bと変数Cはパラレルに扱われる
(\|[A B C] :: A<-[0..6],IF (EVENP A),B<-[x 'y z] : C<-[0..])

EVAL===>
((0 CLPGK.MSPACE::|x| 0) (0 Y 1) (0 CLPGK.MSPACE::|z| 2)
 (2 CLPGK.MSPACE::|x| 3) (2 Y 4) (2 CLPGK.MSPACE::|z| 5)
 (4 CLPGK.MSPACE::|x| 6) (4 Y 7) (4 CLPGK.MSPACE::|z| 8)
 (6 CLPGK.MSPACE::|x| 9) (6 Y 10) (6 CLPGK.MSPACE::|z| 11))

バックトラック記法をQiオリジナルのものから若干アレンジ

(\def test
      X ,(integer? X) <- (PROGN (PRINT 'first)
                                (if (< 5 X) @failure result-1))
      X ,(integer? X) <- (PROGN (PRINT 'second)
                                (IF (ODDP X) @failure result-2))
      _ -> result-3)

(#~test 5)
EVAL===>
FIRST
CLPGK.MSPACE::|result-1|

(#~test 10)
EVAL===>
FIRST 
SECOND
CLPGK.MSPACE::|result-2|

(#~test 11)
EVAL===>
FIRST 
SECOND
CLPGK.MSPACE::|result-3|

(#~test nil)
EVAL===>
CLPGK.MSPACE::|result-3|

埋め込みラムダ式の生成するクロージャは、引数が不足する場合に自動的に部分適用されます

(let ((f (\. X Y Z -> [Z Y X])))
  (print (funcall f 1 2 3))
  (print (funcall (funcall f 4 5) 6))
  (print (funcall (funcall (funcall f 7) 8) 9)))

EVAL===>
(3 2 1) 
(6 5 4) 
(9 8 7)

正規表現でのマッチをも実現する、変態お気楽パターンマッチ構文

(defun pmatch (val)
  (\\case VAL
          0 -> zero
          [] -> empty 
          X,(number? X) ->  (#number X)
          (@ X |hello.*world!|) -> [hello-world X]
          (when string?) -> 'other-string
          (WHEN CONSP) -> 'cons
          (@ X (and (UNLESS KEYWORDP) (WHEN SYMBOLP))) -> [X symbol-but-not-kwd]
          _ -> other
          ))

(let ((src '(0 nil 1.0 "hello world!" "helloworld" (1) world :hello)))
  (pgk:zip src (mapcar #'pmatch src)))
EVAL===>
((0 CLPGK.MSPACE::|zero|) (NIL CLPGK.MSPACE::|empty|)
 (1.0 #(CLPGK.MSPACE::|number| 1.0))
 (#1="hello world!" (CLPGK.MSPACE::|hello-world| #1#))
 ("helloworld" OTHER-STRING) ((1) CONS)
 (WORLD (WORLD CLPGK.MSPACE::|symbol-but-not-kwd|))
 (:HELLO CLPGK.MSPACE::|other|))

以上、ほんの一部です。

今後の課題

既製の言語コアを流用することで、コア以外の必要としない部分も若干くっついてきました
組み込み関数の一部、特にIO関連のものなどはコンパクトな埋め込み関数型言語を目指す上でまったく必要ありませんので、これらを取り除く作業が必要です
また、CLと相容れないような名称あるいは挙動の組み込み関数がいくつかあり、これもどうにかしないといけません
現状パターンマッチやリスト内包表記はCLに埋め込んでかなり便利に使えていますが、更にガンガン活用するならば、よく設計された最小サイズのライブラリを構築する必要があると考えています