小ネタ: define-method-combinationで遊ぶ

Common Lisp

Lisp メソッドコンビネーション Advent Calendar 2018の4日目の記事です。

枠が空きそうな雰囲気だったので、前日の define-method-combination 解説記事を書いていて思い付いた小ネタを供養しておきます。

Blackhole: 呼ぶと消える

一度呼んだら消えてしまう儚いメソッドを定義できるメソッドコンビネーションです。

(define-method-combination blackhole ()
  ((primary ()))
  (:generic-function gen)
  `(list ,@(mapcar #'(lambda (method)
                       `(prog1 (call-method ,method)
                          (remove-method ,gen ,method)))
                   primary)))

(defgeneric vanish (a) (:method-combination blackhole))

(defmethod vanish (a) "a is any type")
(defmethod vanish ((a number)) "a is number")
(defmethod vanish ((a fixnum)) "a is fixnum")

(defun call-vanish (a)
  (handler-case (vanish a)
    (error (e) (print e) nil)))

呼んでみます。

;; 呼びます
CL-USER> (call-vanish 10.0)
("a is number" "a is any type")
;; 消えます
CL-USER> (call-vanish 10.0)
#<NO-APPLICABLE-METHOD-EXISTS #x302000E4A6AD>
NIL

;; 呼んでないところは生きてます
CL-USER> (call-vanish 10)
("a is fixnum")
;; でもやっぱり消えます
CL-USER> (call-vanish 10)
#<NO-APPLICABLE-METHOD-EXISTS #x302000E11F0D>
NIL

defgenericの引数で別の generic-function を指定できるようにして、 そこに add-method することでメソッドが移動するホワイトホールとか、それをお互いに指定することで呼ぶ度に相手に移動する惑星メソッドとかできるんじゃないかと考え始めた辺りでやめました。

Escher: 親の親は自分

call-next-method で親？メソッドを辿っていくと自分自身に行きつくメソッドを定義できるメソッドコンビネーションです*1。

(define-method-combination escher (&optional (num-repeat 100))
  ((primary ()))
  (let ((shifted (append (rest primary) (list (first primary)))))
    `(call-method ,(first primary)
                  ,(loop :for i :from 0 :below num-repeat :append shifted))))

(defgeneric fact (a) (:method-combination escher 100))

(defmethod fact (a)
  (format t "in root: ~a~%" a)
  (if (and (numberp a) (> a 1))
      (* a (call-next-method (1- a)))
      1))

(defmethod fact ((a fixnum))
  (format t "in fixnum: ~d~%" a)
  (if (> a 1)
      (* a (call-next-method (1- a)))
      1))

呼んでみます。

CL-USER> (fact 5)
in fixnum: 5
in root: 4
in fixnum: 3
in root: 2
in fixnum: 1
120

Increment: 呼んだらインクリメント

呼び出す度にインクリメントする関数の定義というと、クロージャの説明で良く利用されますね。

メソッドコンビネーションで同じようなことをやってみます。呼び出す度に defmethod で定義し直す力業です。

(ql:quickload :closer-mop)

(define-method-combination increment ()
  ((primary ()))
  (:generic-function gen)
  (let ((method (first primary)))
    `(let* ((result (call-method ,method))
            (next (if (typep result 'fixnum)
                      (1+ result)
                      0)))
       (defmethod ,(closer-mop:generic-function-name gen) (&optional (a next)) a)
       result)))

(defgeneric inc (&optional a) (:method-combination increment))

(defmethod inc (&optional a) :start)

呼んでみます。

CL-USER> (dotimes (i 10) (print (inc)))

:START
0
1
2
3
4
5
6
7
8
NIL

オプショナル引数を利用することで、任意の値から再開することもできます。

CL-USER> (inc 100)
100
CL-USER> (inc)
101

最早コンビネーション感がありません。

FizzBuzz: 王道ネタ

Incrementのマイナーチェンジですが、せっかくなのでFizzBuzzしてみます。

なお、メソッドコンビネーションによるFizzBuzzには下記の先行研究があります。

(ql:quickload :closer-mop)

(define-method-combination fizz-buzz ()
  ((primary ()))
  (:generic-function gen)
  (let ((method (first primary)))
    `(multiple-value-bind (result real-value) (call-method ,method)
       (let ((next (if (typep real-value 'fixnum)
                       (1+ real-value)
                       1)))
         (defmethod ,(closer-mop:generic-function-name gen) (&optional (a next))
           (if (typep a 'fixnum)
               (values (cond ((= (mod a 15) 0) "Fizz Buzz")
                             ((= (mod a 5) 0)  "Buzz")
                             ((= (mod a 3) 0)  "Fizz")
                             (t a))
                       a)
               (values 1 1)))
         result))))

(defgeneric fz (&optional a) (:method-combination fizz-buzz))

(defmethod fz (&optional (a)) :start)

呼んでみます。内部の defmethod は多値を返すように定義していますが、表からは見えない辺りが気持ち悪くて良い感じです。

CL-USER> (dotimes (i 20) (print (fz)))

:START
1
2
"Fizz"
4
"Buzz"
"Fizz"
7
8
"Fizz"
"Buzz"
11
"Fizz"
13
14
"Fizz Buzz"
16
17
"Fizz"
19
NIL

こちらも、オプショナル引数を渡すことで任意位置からの再開ができます。

CL-USER> (fz 3)
"Fizz"
CL-USER> (fz)
4

メソッドコンビネーションがなんだか分からなくなってきました。

おわり

*1:本当は call-method の第2引数に循環リストを渡したかったのですが、call-next-methodでスタックオーバーフローしてしまうので泣く泣く回数制限をつけました。

define-method-combinationを理解する

Lisp

Lisp メソッドコンビネーション Advent Calendar 2018の3日目の記事です。

任意のメソッドコンビネーションを自作するマクロであるdefine-method-combinationのリファレンス(CLHS)を眺めていたのですが、中々理解するのに苦労しました。次のような所に難しさがある気がします。

  • どの部分が任意に決めて良いもので、どの部分が決まった文法なのか分かりにくい
  • どの部分がいつ利用・評価されるのか分かりにくい
    • defgeneric時なのか、defmethod時なのか、コンパイル時なのか、実行時なのか…
  • （そもそも用語が多い上に動きもイメージし辛いので、↑の辺りが飲み込めてこないと説明を見ても頭に入ってこない）

この辺りを念頭に置きつつ、例を見ながら理解した内容を整理したいと思います。

段階的で良い感じだったので、例としてはCLHS内のorの例を中心に見ていきます。

前置き：メソッドコンビネーション or の動作

メソッドコンビネーション or の動作について1例を。or という名称から想像が付くように、非nilが返る（か最後に到達する）まで適用可能なメソッドを順に呼んでいきます。

;; ※def系の出力略
CL-USER> (defgeneric test-or (a) (:method-combination or))
CL-USER> (defmethod test-or or ((a fixnum)) ; 結果がnilなので次も呼ぶ
           (print "fixnum type returns nil")
           nil)
CL-USER> (defmethod test-or or ((a number)) ; 結果がtrueなのでここで終わり
           (print "number type returns t")
           t)
CL-USER> (defmethod test-or or (a) ; 下の例では呼ばれない
           (print "any type returns nil")
           nil)
CL-USER> (test-or 1)

"fixnum type returns nil"
"number type returns t"
T

なお、"7.6.6.4 Built-in Method Combination Types"にあるようにビルトインのメソッドコンビネーションとして存在します。

Short Form

define-method-combination には、Short FormとLong Formの2つの形態があります。この記事ではLong Formの説明を中心に行いたいので、Short Formについては下のようにすれば or を定義できますという程度に留めます。

(define-method-combination or :identity-with-one-argument t)

なお、:identity-with-one-argumentはちょっとした最適化のためのオプションで、or や progn, +, max のように、1引数で呼び出した場合にその引数の結果がそのまま全体の結果となる（Ex. (or x) -> x）ようなオペレータに対して指定できます。

Long Form

本題のLong Formです。

CLHSのdefine-method-combinationの項より、定義のうち後ろの説明で出てくるあたりを抜粋しておきます。

define-method-combination name lambda-list (method-group-specifier*) form*

method-group-specifier::= (name {qualifier-pattern+ | predicate} [[long-form-option]])

短めのLong Form

orの実装例として3つのLong Formが示されていますが、まずはその中でもShortなLong Formの例です。後述のLongなLong Formと見比べるとかなり短いですが、こちらがじっくり理解できれば、Longな方もすんなり入ってくると思います。

(define-method-combination or ()
  ((methods (or)))
  `(or ,@(mapcar #'(lambda (method)
                     `(call-method ,method))
                 methods)))

前の方から順番に見ていきます。

まずは定義の name に当たる or ですが、これはもちろん (defgeneric method (:method-combination or)) で指定する名前です。Long Formにおいては名前以上の意味を持たないので任意につけて問題ありません。

次にlambda-formに当たる部分ですが…今の例では空（()）なので後ろで見ます。ここで定義したものもdefgenericで利用するという部分だけ抑えておきます。

肝となるのが、次の(method-group-specifier*)に当たる((methods (or)))です。これはletのように(変数名 束縛対象)の組み合わせが並んだものです。ここでは、(methods (or))の一組だけが定義されています。

まずはmethodsです。この部分、他の例も合わせて見るとbeforeやらafterやらprimaryやら、いかにも意味ありげな名前がついているため、何か決まりがあるようにも見えます。が、define-method-combination内部（後に続くform内）だけで利用する変数名なので、letの要領で好きに名前をつければ良いです。ここには、defmethodで定義されるメソッドのリストが（よりspecificなものが前に来る順序で）束縛されます。例えば、下のような定義がある場合、(test-or 100)という呼び出しに対してはA, B, Cの3つのメソッドが、(test-or :hoge)という呼び出しに対してはCのメソッドのみが、リストの要素になってmethodsに束縛されます。

;; ※冒頭の例を再掲
CL-USER> (defgeneric test-or (a) (:method-combination or))
CL-USER> (defmethod test-or or ((a fixnum)) ; --- A
           (print "fixnum type returns nil")
           nil)
CL-USER> (defmethod test-or or ((a number)) ; --- B
           (print "number type returns t")
           t)
CL-USER> (defmethod test-or or (a) ; --- C
           (print "any type returns nil")
           nil)

束縛時に選択されるメソッドについてさらに詳しく見ると、次の2つに共に合致するものが選ばれます。

  • 実行時の情報を利用する動的なマッチング
    • 平たく言えば型による（多重）ディスパッチのことです *1
  • 定義時の情報を利用する静的なマッチング（以下の2つのマッチング）
    • define-method-combination で指定する method-group-specifier（ここで議論している(methods (or))のこと）
    • defmethod で指定する method-qualifier
      • (defmethod hoge-method :a :b :c (x y) ...) のようにメソッド名と引数リストの間に任意の数のシンボルを書くことができ、これをリストにしたもの（(:a :b :c)）をmethod-qualifierと呼びます

つまり、(methods (or))の(or)はdefmethod時に、定義されたメソッドをmethodsに束縛するべきかを静的に判断するための情報になります。(defmethod test-or or (a) ...)におけるorの指定は一見二度手間に見えますが、define-method-combinationで指定されているために必要なものということになります。逆に言うと、defmethod時に指定させたいものであればなんでも良く、メソッドコンビネーション自体の名前orと一致させているのは単にその方が分かり易いからというだけの理由です。

さて、(or)はリスト形式での指定の1例でしたが、大きくは以下3つの指定方法があります。定義上は最初の2つが qualifier-pattern にあたるもので、3つ目が predicate に相当します。

  • シンボル（*のみ可）: 任意の値・数のmethod-qualifierにマッチ
    • 例. (methods *)
  • リスト: method-qualifier との equal 結果がtrueとなるものにマッチ
    • 例. (methods (a b))とした場合、(defmethod hoge a b (arg) ...) のようなメソッドにマッチ
    • 補足
      • ()とすると、(defmethod hoge (arg) ...)のようにmethod-qualifierの指定がないものにマッチ
      • (a . *)のようにすると、car部がaの任意のmethod-qualifierにマッチ
      • 要素数2つ以上のリストなんていつ使うんだろうか…
  • 関数シンボル: method-qualifierを引数として渡して結果がtrueとなるものにマッチ
    • 例. 次のような定義のqualifier-number-p関数を定義したとすると、(methods qualifeir-number-p)は(defmethod hoge 999 (arg) ...)のようなメソッドにマッチ
(defun qualifier-number-p (method-qualifier)
  (and (= (length method-qualifier) 1)
       (numberp (car (method-qualifier)))))

なお、複数の method-group-specifier にマッチする場合は、定義順で最初にマッチしたものに束縛される仕様です。

最後にようやく form* 部分です。formの目的は、methods に束縛されたメソッドのリストをどのように呼び出すかを決定することです。例えば、先頭のメソッドを1つ呼びたいだけであれば次のように書けます。

  `(call-method ,(first methods))

特徴的なのは call-method ですが、名前の通りメソッドの呼び出しを指示するものです。関数に対する funcall のメソッド版とイメージすると分かり易いかと思います。ただし、funcall とは異なりメソッド自体の引数は隠蔽されています。メソッドそのものとは別にoptionalな引数を1つ取りますが、これについては次の節で見ていきます。

さて、改めて実装例を見てみると、form部分ではorの中にリスト内の各メソッドに対する call-method を繋ぎ込んでいることが分かります。これにより、前から順にtrueが出るまでメソッドを呼び出すという動作を実現できたことになります。

;; ※再掲
(define-method-combination or ()
  ((methods (or)))
  `(or ,@(mapcar #'(lambda (method)
                     `(call-method ,method))
                 methods)))

長めのLong Form

CLHSには or のより長い実装例が2つありますが、一度に色々取り込んでいて説明しづらいので、少しずつ足しながら見ていきます。

aroundの実装

いわゆるaround機能を付加します。この実装から次のことを見ていきます。

  • call-method の第2引数について
  • make-method について

先にaroundの動作を簡単に確認します。下記のように、本来呼び出されるはずの{1}に先立ち、{2}でaroundとして定義したメソッドが呼び出されます。本来のメソッド{1}を呼び出すためには call-next-method を利用して明示的に呼び出す必要があります。

CL-USER> (defgeneric test-or (a) (:method-combination or))
CL-USER> (defmethod test-or or (a) (print "primary") t) ; --- {1}
CL-USER> (defmethod test-or :around (a) ; --- {2}
           (print "around")
           (call-next-method a))
CL-USER> (test-or 100)

"around"
"primary"
t

そしてその実装です。

(define-method-combination or ()
  ((around (:around))
   (primary (or))
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                              primary)))))
    (if around
        `(call-method ,(first around)
                      (,@(rest around)
                          (make-method ,form)))
        form)))

まず目に付くのは、method-group-specifier が2つに増えている部分です。(defmethod hoge :around (...) ...)を引っかけるために、(around (:around)) が追加されています。なお短めの実装の方で methods となっていたものは primary となっていますが、これは束縛先の名前が変わっただけです。

次に、短めの実装では直接書き下していた本体部分を、いったん let で form という変数に束縛しています*2。続く (if around ...) のelse部分では単純にこれを置くだけなので、短めの実装と同じ動作になります。

ということで、around が存在する場合の処理を見てみます。まず、call-methodの第1引数としてaroundの最初のメソッドを渡すことで、aroundとして定義したメソッドを呼び出していることが分かります。そして第2引数としてメソッドのリストを渡しています。これは、call-next-method（とnext-method-p）で内部的に利用されるリストで、ここにあるものを前から順に呼んでいくことになります。さて、実装例を見ると2つのものを連結してリストを作成しています。1つはaroundの残りの部分です。もう1つが初登場のmake-methodの返り値です。これは、読んで字のごとくメソッドを生成する関数 *3 です。引数として form を受け取って、これをメソッド化します。

orderの実装

次にメソッドの呼び出し順序の実装です。この実装から次のことを見ていきます。

  • メソッドコンビネーションの引数
  • method-group-specifier の引数

先に呼び出し順を逆順にする例を確認します。

;; defgeneric で :most-specific-last を指定
TEMP> (defgeneric test-or-rev (a) (:method-combination or :most-specific-last))
TEMP> (defmethod test-or-rev or ((a fixnum)) ; ここは呼ばれない
        (print "fixnum type returns nil")
        nil)
TEMP> (defmethod test-or-rev or ((a number)) ; ここまで呼ばれる
        (print "number type returns t")
        t)
TEMP> (defmethod test-or-rev or (a) ; ここから呼ばれる
        (print "any type returns nil")
        nil)
TEMP> (test-or-rev 1)

"any type returns nil"
"number type returns t"
T

そしてその実装です。

(define-method-combination or
    (&optional (order ':most-specific-first)) ; ここに引数 order を追加
  ((around (:around))
   (primary (or) :order order)) ; ここで order を指定
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                              primary)))))
    (if around
        `(call-method ,(first around)
                      (,@ (rest around)
                          (make-method ,form)))
        form)))

さっくり見ていきます。

  • メソッドコンビネーションの引数 = (&optional (order ':most-specific-first)
    • defgeneric時に利用されるもので、本節最初の例で:most-specific-lastを指定していた部分に相当します
    • ※短めの例では空リストとなっていた部分です
  • method-group-specifier の引数 = (primary (or) :order order)
    • defgeneric 時に指定した引数を元に実行順序を指定しています
    • この引数には :order の他に次の2つがあります
      • :description は名前の通りドキュメント用の文字列を取ります
      • :requied をtrueとすると、該当するメソッドが見つからない場合実行時にエラーとなります
long-form-option::= :description description | 
                    :order order | 
                    :required required-p

なお、method-group-specifier の引数 :order を利用せずとも、次のように自前で実行順序の実装をすることもできます。前述のように、primary にはメソッドのリストが束縛されるため、逆順にしたければ単にこれを reverse するだけです。もちろん、必要に応じて任意の順序に並び換えることもできます。

(define-method-combination or
    (&optional (order ':most-specific-first))
  ((around (:around))
   (primary (or)))
  ;; 自前での実行順序実装
  (case order
    (:most-specific-first)
    (:most-specific-last (setq primary (reverse primary)))
    (otherwise (method-combination-error "~S is an invalid order.~@
     :most-specific-first and :most-specific-last are the possible values."
                                         order)))
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                             primary))))
    (if around
        `(call-method ,(first around)
                      (,@(rest around)
                         (make-method ,form)))
        form)))

requiredの実装

orderの部分で既に触れていますが、該当するメソッドが見つからない場合、実行時にエラーとする機能の実装です。

単純なので実装を並べて終わりにします。次の例では、 primary に該当するメソッドがない場合、実行時にエラーとなります。

(define-method-combination or
    (&optional (order ':most-specific-first))
  ((around (:around))
   (primary (or) :order order :required t)) ; ここに追加
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                              primary)))))
    (if around
        `(call-method ,(first around)
                      (,@ (rest around)
                          (make-method ,form)))
        form)))

もちろん、自前でも実装できます。

(define-method-combination or
    (&optional (order ':most-specific-first))
  ((around (:around))
   (primary (or)))
  (case order
    (:most-specific-first)
    (:most-specific-last (setq primary (reverse primary)))
    (otherwise (method-combination-error "~S is an invalid order.~@
     :most-specific-first and :most-specific-last are the possible values."
                                         order)))
  ;; ここが required に相当する実装
  (unless primary
    (method-combination-error "A primary method is required."))
  (let ((form `(or ,@(mapcar #'(lambda (method)
                                 `(call-method ,method))
                             primary))))
    (if around
        `(call-method ,(first around)
                      (,@(rest around)
                         (make-method ,form)))
        form)))

落ち穂拾い

上記で抜粋した定義では省略していましたが、他に :arguments と :generic-function という任意オプションがありますので、それぞれ簡単に見てみます。

define-method-combination name lambda-list (method-group-specifier*) [(:arguments . args-lambda-list)] [(:generic-function generic-function-symbol)] form*

:arguments

:arguments を利用すると、メソッド実行時にメソッドの引数を拾うことができます。

(define-method-combination ex-of-arguments ()
  ((primary ()))
  (:arguments a)
  `(progn (format t "Use arguments: ~A" ,a)
          ,@(mapcar #'(lambda (method)
                        `(call-method ,method))
                    primary)))

(defgeneric arg-test (x y) (:method-combination ex-of-arguments))

(defmethod arg-test ((x fixnum) (y fixnum))
  (+ x y))

;; 実行例
CL-USER> (arg-test 1 2)
Use arguments: 1
3

何に使えるのかは良く分かりませんが、CLHSではロックに使う例を紹介しています。

 (define-method-combination progn-with-lock ()
         ((methods ()))
   (:arguments object)
   `(unwind-protect
        (progn (lock (object-lock ,object))
               ,@(mapcar #'(lambda (method)
                             `(call-method ,method))
                         methods))
      (unlock (object-lock ,object))))

:generic-function

:generic-function を利用すると、generic function自体を受け取ることができます。

(ql:quickload :closer-mop)

(define-method-combination ex-of-gen ()
  ((primary ()))
  (:generic-function gen)
  `(progn (print (closer-mop:generic-function-name ,gen))
          ,@(mapcar #'(lambda (method)
                        `(call-method ,method))
                    primary)))

(defgeneric gen-test () (:method-combination ex-of-gen))

(defmethod gen-test () :hoge)

何に使えるのかはさっぱり見当がつきません。こちらに至ってはCLHSにすら例がありません。

おまけ: standardの実装

method-qualifierを取らなかったり、:beforeや:afterがあったりと、何かと特別な感じがするデフォルトのメソッドコンビネーションですが、その気になれば自前で実装できますという例がCLHSに載せられています。

新しい要素はないため例をそのまま掲載するだけですが、これを眺めていると define-method-combination は良くできているものだなあと感心してしまいます。

 (define-method-combination standard ()
         ((around (:around))
          (before (:before))
          (primary () :required t)
          (after (:after)))
   (flet ((call-methods (methods)
            (mapcar #'(lambda (method)
                        `(call-method ,method))
                    methods)))
     (let ((form (if (or before after (rest primary))
                     `(multiple-value-prog1
                        (progn ,@(call-methods before)
                               (call-method ,(first primary)
                                            ,(rest primary)))
                        ,@(call-methods (reverse after)))
                     `(call-method ,(first primary)))))
       (if around
           `(call-method ,(first around)
                         (,@(rest around)
                          (make-method ,form)))
           form))))

おわりに

Q. それで、define-method-combination っていつ使うんですか？
A. さあ？

*1:厳密にはeqlによるディスパッチもありますが

*2:この部分、CLHSの例ではShort Formの:identity-with-one-argumentで述べたような1引数の場合の最適化が入っているのですが、見辛いので省略しました。以降同じです

*3:関数またはマクロ？CLHSを見る限り明言されていないようでした

AWS LambdaでDockerHubの定期ビルドを設定したときのメモ

AWS AWS Lambda プログラミング

DockerHubに登録しているCommon Lisp実行環境eshamster/cl-baseと、それをベースとした開発環境eshamster/cl-devel2ですが、RoswellやQuicklispリポジトリがそれなりの頻度で更新されるので、latestに対しては定期的に更新をかけておきたかったです。そのために、AWS Lambdaをcron代わりに設定したときのメモです。

単なるメモなので過不足たくさんで、特にまとまってもいません。

想定読者

  • AWSアカウント作ったは良いものの特に使ってない人
  • それcronで良くない？と言わない人 *1

想定シチュエーション

  • 大体の操作はWebコンソールで実施する
    • 特に高度な使い方はしていないので、メモは極薄です
  • 言語には取りあえずNode.jsを選択する（執筆時点で最新のNode.js 8.10）
  • Node.jsのモジュールを含めたいので関数の実体は手元の開発機で作成する
    • 開発機がリモートにあってWebコンソールではzipの移動が面倒なので、アップロードだけはawsコマンドで実施する

開発環境の用意（on Docker）

Node.jsの開発やAWSへのアップロードを行うための開発環境を作っておきます。ということで、まずDockerfileを用意します。

lessは最初から入っていますが、デフォルトではaws helpでエラーになってしまうので、アップデートしておきます。ついでに、デフォルトのviだけでは物寂しいのでvimを入れておきます。

FROM node:8.10.0-alpine

RUN apk --update add py-pip && \
    pip install awscli &&\
    apk --update add less groff && \
    apk --update add vim

WORKDIR /root

RUN mkdir /root/.aws

COPY credentials config /root/.aws/
COPY .vimrc /root/

毎回 aws configure するのも面倒なので、同コマンドで生成されるファイルを用意しておいて、docker build時にコピーしてしまいます。後から思うに、この辺りは環境変数の設定でやる方が賢かった気がします。

$ cat config
[default]
output = json
region = us-west-2

$ cat credentials
[default]
aws_access_key_id = XXXXXXXXXXXXX
aws_secret_access_key = XXXXXXXXXXXXX

.vimrcですが、普段はEmacsを使っていて特にこだわりの設定もないので、タブの設定だけしておきます。好み8割、AWS LambdaのWebエディタのデフォルト設定に合わせて置きたい気持ちが2割です。

$ cat .vimrc
set expandtab
set tabstop=4
set shiftwidth=4

ここまでのものはcredentialsを.gitignoreした上でGitHubに上げました。

github.com

IAMの設定

  • 適当にユーザを用意します
    • （credentialsの設定をしているので済のはずですが）
  • 適当にグループを用意して上記のユーザを所属させます
  • グループにインラインポリシーを設定します

「AWS Lambda でアイデンティティベースのポリシー (IAM ポリシー) を使用する」あたりも見つつ、必要なActionだけを登録していく…つもりだったのですが、面倒になってlamdba:*としてAWS Lambda系の関数を全許可しています*2。

なお、アップロードしたファイルはS3上に置かれるようなので、ダウンロードしようと思うとS3系の権限もいるのかもしれません（今回は一方的なアップロードしかしていないので試していません）。

{
    "Version": "2012-10-17",
    "Statement": [
        {
            "Sid": "AllLambdaFunctions",
            "Effect": "Allow",
            "Action": "lambda:*",
            "Resource": "*"
        }
    ]
}

反映には数分かかるようなので他にすることがなければ待ちます。

# Dockerコンテナ上
$ while : ; do aws lambda list-functions ; if [ $? -eq 0 ]; then break ; fi ; sleep 10; done

関数を作成する

AWS Lambdaに関数を追加する

Webコンソール上で適当に作成してNode.js 8.10を選んでおきます。以上。

関数の実体を作成する

Dockerコンテナ上での作業です。Docker HubのビルドをトリガするためのNode.jsファイルを作成します。

準備として、フォルダを用意してcurl代わりのrequestモジュールをインストールしておきます。

$ mkdir sample
$ cd sample
$ npm install request

Node.jsコードの前に、curlでlatestタグのビルドをトリガする凡例を示すと次のようになります。<image_name>は、例えばeshamster/cl-baseで、<token>はDocker HubのBuild Settingsのページで取得できます（また、同ページでcurlの例を見ることもできます）。

$ curl -H "Content-Type: application/json" --data '{"docker_tag": "latest"}' -X POST https://registry.hub.docker.com/u/<image_name>/trigger/<token>/

requestモジュールを使って、これをNode.js実装に置き換えます。TODOがあったりエラー処理がおざなりだったりしますが見なかったことにします。${event.*}の部分が実行時に与えるパラメータです。docker_tagの指定もパラメータ化した方が良い気もしますが、当面latest以外に適用する見込みもなかったので直に指定しました。

$ cat index.js
exports.handler = (event, context) => {
    const request = require('request');

    /* TODO: Check event.image_name and event.token */

    let options = {
        url: `https://registry.hub.docker.com/u/${event.image_name}/trigger/${event.token}/`,
        method: 'POST',
        headers: {
            'Content-Type': 'application/json',
        },
        body: JSON.stringify({ "docker_tag": "latest" })
    };

    let response = request(options, (err, res, body) => {
        console.log('ERR: ' + err);
    });
    return response;
};

アップロードする

zip化した上で、AWS Lambdaにアップロードします。

zip化ですが、解凍されたときにindex.jsがルートに来るように注意します。

$ cd ~/sample
$ ls
index.js           node_modules       package-lock.json
$ zip -r ../sample.zip *
...

ここまで来れば、後はコマンド1発でアップロード完了です。

$ cd
$ aws lambda update-function-code --zip-file fileb://sample.zip --function-name <function名>

helpが充実しているので、それらしいサブコマンドを aws lambda help で見繕って、さらにそのサブコマンドのhelpを見る、という感じで使い方が分かるのは良いですね。

AWS Lambdaの設定

ここからはまたWebコンソール上での作業です。

タイムアウトの設定変更

DockerHubからレスポンスが返ってくるまで数秒かかるので、デフォルトのタイムアウト（3秒）では心許ないです。10秒にしておきます。

CloudWatchの設定

cron代わりにCloudWatch Eventsを設定します。

イベントソースはcron式のスケジュールを設定します（例. 0 15 ? * FRI * ← 日本時間の土曜0時）。rate式にしなかったのは、 近い時間にcl-base → cl-devel2 と実行したかったためです。

入力の設定は「定数 (JSON テキスト)」を選択し、先程のNode.jsソースの${event.*}に対応する値を設定します。

{
  "image_name": "eshamster/cl-base",
  "token": "xxxxxxxxxxxxxxx" 
}

以上で週1でDockerHub上のイメージの更新が走るようになりました（完）

*1:cronにしなかったのは、単にAWS Lambda 使ってみたかったというのが主な理由で、開発機（VM）はできるだけ軽くしておきたいというのがもう一つの理由です

*2:権限が足りない場合、エラーメッセージでどのActionの権限がないか丁寧に教えてくれるので難しいことはないのですが、後述の、反映に数分かかるのが面倒臭く…

[Common Lisp] Obsoletedなエイリアスを定義するマクロ

Common Lisp Lisp

小さなマクロ1個の小ネタ（＋おまけ）です。

ライブラリを書き、ある程度使ったあたりで関数名などの命名のまずさに気付くこともあると思います。かといって、いくつかのプロジェクトで使い始めているので、今さら名前を変更するのも面倒臭い…。そういったときに、旧名はエイリアスとして残しておいて、使われたときには警告を出すというのは常套手段であると思います。

Common Lispにはそういった時にデフォルトで利用できるものが見つからなかったので、6行程度の簡単なマクロを書いてみたメモです。

目次

利用イメージ

(defun bad-name-func (x y)
  (+ x y))

うっかりダメな名前で関数を作ってしまった…。しかも、もう外で使われている…。

(defun good-name-func (x y)
  (+ x y))

(def-obsoleted-alias bad-name-func good-name-func)

関数名を改善する。互換性を保ちたいので、旧名もエイリアスとして残しておく（def-obsoleted-alias の実装は後述）。

> (bad-name-func 1 2)
; Warning: "BAD-NAME-FUNC" is obsoleted. Please use "GOOD-NAME-FUNC" instead.
; While executing: BAD-NAME-FUNC, in process repl-thread(13).
3

引き続き旧名も使える、が怒られる。

実装

def-obsoleted-alias の実装は次の通りです。エイリアスとして旧名でマクロを生成します。生成されたマクロは利用時（コンパイル時）に警告を出力します。

(defmacro def-obsoleted-alias (obsoleted-name alter-fn)
  (let ((rest (gensym)))
    `(defmacro ,obsoleted-name (&rest ,rest)
       (warn ,(format nil "\"~A\" is obsoleted. Please use \"~A\" instead."
                      obsoleted-name alter-fn))
       `(,',alter-fn ,@,rest))))

未だにマクロを生成するマクロはじっくり見ていると良く分からなくなってくるので、一例展開してみると次のようになります。生成されたbad-name-macroマクロは、利用箇所で単なるgood-name-funcの呼び出しに展開されるため、実行時のオーバーヘッドはありません。

(def-obsoleted-alias bad-name-func good-name-func)
;; ->
(defmacro bad-name-func (&rest #:g346681)
  (warn "\"bad-name-func\" is obsoleted. Please use \"good-name-func\" instead.")
  `(good-name-func ,@#:g346681))

次に書く問題はあるのですが、お手軽なのでちょっとした用途には十分かと思います。

その問題ですが、bad-name-funcが関数からマクロに変わってしまったため、applyしているなど明示的に関数扱いしているコードに対しては互換性を保てないというものです。後ろのおまけで関数生成バージョンも試してみますが、マクロ生成バージョンではコンパイル時に警告を出せるのに対し、関数生成バージョンでは実行時まで警告を出せません。差し引きで（簡易利用用途としては）マクロ生成バージョンの方が良いだろうと思っています。

おまけ

関数生成バージョン

エイリアスをマクロとしてではなく関数として生成してみます。

前述の通り、警告の出力タイミングは実行時になります。頻繁に利用する関数で何度も警告を出すと応答不可になりかねないので、一度警告が出された関数はハッシュテーブルに記録して二度は出ないようにしています*1。

(defvar *table-output-obsoleted-warning* (make-hash-table))
(defun has-output-obsoleted-warning-p (obsoleted-name)
  (gethash obsoleted-name *table-output-obsoleted-warning*))
(defun register-output-obsoleted-warning (obsoleted-name)
  (setf (gethash obsoleted-name *table-output-obsoleted-warning*) t))

(defmacro def-obsoleted-fun (obsoleted-name alter-fn)
  (let ((rest (gensym)))
    `(defun ,obsoleted-name (&rest ,rest)
       (unless (has-output-obsoleted-warning-p ',obsoleted-name)
         (warn ,(format nil "\"~A\" is obsoleted. Please use \"~A\" instead."
                        obsoleted-name alter-fn))
         (register-output-obsoleted-warning ',obsoleted-name))
       (apply #',alter-fn ,rest))))

展開例は次のようになります。

(def-obsoleted-fun bad-name-func good-name-func)
;; ->
(defun bad-name-func (&rest #:g346722)
  (unless (has-output-obsoleted-warning-p 'bad-name-func)
    (warn "\"bad-name-func\" is obsoleted. Please use \"good-name-func\" instead.")
    (register-output-obsoleted-warning 'bad-name-func))
  (apply #'good-name-func #:g346722))

アノテーションにしてみる

関数のObsolete化というと、C# のObsolete属性や Java の @deprecated アノテーションのように、アノテーション的にやるイメージがあるので、試しに cl-annotを使ってアノテーション化してみます。

(ql:quickload :cl-annot)
(use-package :cl-annot)
(enable-annot-syntax)

(defannotation obsoleted-alias ((&rest obsoleted-names) definition-form) (:arity 2)
  `(progn ,@(mapcar (lambda (name)
                      `(def-obsoleted-alias
                           ,name
                           ,(cl-annot.util:definition-form-symbol definition-form)))
                    obsoleted-names)
          ,definition-form))

次のように使います。一応、obsoletedな名前はカッコ内に複数並べて書けるようにしています。これで何度下手な名付けをしても安心です :-)

@obsoleted-alias (bad-name-func)
(defun good-name-func (x y)
  (+ x y))

本格的にcl-annot と連携しようと思うと、 @export （など？）との兼ね合いも考えないといけないので、これでは足りないのでしょうね…。

追記：コンパイラマクロ利用版

コメントでコンパイラマクロを利用する方法を教えて頂きました。「コンパイル時に何か（警告出力）したい」という話なので確かにコンパイラマクロが適任ですね。頭になかったです……。

(defmacro def-obsoleted-alias (obsoleted-name alter-fn)
  (let ((rest (gensym)))
    (flet ((make-body ()
             (if (macro-function alter-fn)
                 ``(,',alter-fn ,@,rest)
                 `(apply #',alter-fn ,rest))))
      `(progn (,(if (macro-function alter-fn) 'defmacro 'defun) ,obsoleted-name (&rest ,rest)
                ,(make-body))
              (define-compiler-macro ,obsoleted-name (&rest ,rest)
                (warn ,(format nil "\"~A\" is obsoleted. Please use \"~A\" instead."
                               obsoleted-name alter-fn))
                ,(make-body))))))

REPLでの利用時はコンパイルが走らないため警告が出ませんが、最終的にコードに落とす段階で気付けるので実用上の問題はないと思われます。

さらに追記：最初 def-obsoleted-fun の代替として関数対応版を書いたのですが、せっかくなので関数・マクロ両用版に書き直しました。

; ; 準備
(defun good-name-func ())
(defmacro good-name-macro ())

;; 関数の場合
(def-obsoleted-alias bad-name-func good-name-func)
;; ->
(progn (defun bad-name-func (&rest #:g347909)
         (apply #'good-name-func #:g347909))
       (define-compiler-macro
         bad-name-func
         (&rest #:g347909)
         (warn "\"bad-name-func\" is obsoleted. Please use \"good-name-func\" instead.")
         (apply #'good-name-func #:g347909)))

;; マクロの場合
(def-obsoleted-alias bad-name-macro good-name-macro)
;; ->
(progn (defmacro bad-name-macro (&rest #:g347910)
         (list* 'good-name-macro #:g347910))
       (define-compiler-macro
         bad-name-macro
         (&rest #:g347910)
         (warn "\"bad-name-macro\" is obsoleted. Please use \"good-name-macro\" instead.")
         (list* 'good-name-macro #:g347910)))

*1:流石に1回出力ではどこで利用されているかの追跡が困難なので、キーにパッケージも加えて、1つのパッケージで1回までなどとした方が良さそうです

XBLA版, Steam版の斑鳩におけるアナログスティックの挙動について

ゲーム ゲーム-STG ゲーム-STG-斑鳩

XBLA版, Steam版*1の斑鳩におけるアナログスティックの挙動について、↓のような雑なツイートをしました。

個人的にはこのアナログスティックの挙動は大変素晴らしいものだと思っていて、また決して偶然にできるものではなく、アナログな操作感とデジタルな精密さを両立すべく良く練られたものだと思っています。…という内容や気持ちを伝えるにはツイッターでは余白が狭すぎたので、記事にしてみた次第です*2。

目次

前段：8方向の場合

ツイートでは図の見方も説明できていなかったので、その説明も兼ねて8方向のシンプルな場合について考えます。

十字キーやアーケードスティックで自機を操作する場合、上下左右と斜め4方向の、計8方向に動かすことができます。このとき、それぞれの方向の速さを考えてみます。特別な理由がなければ上下左右の4つの速さは等しくするでしょうし、同じく斜め方向の4つの速さも等しくするでしょう。しかし、前者の速さと後者の速さの関係については概ね2つの選択肢が考えられます。

1つはどちらも同じ速さにするというものです。横方向・縦方向の速さを軸とした平面上にこれらを置くと下図のように円周上に並びます。

f:id:eshamster:20180602144720p:plain:w450

もう1つは、斜め移動の場合でも、縦方向の速度、横方向の速度をともに維持するというものです。言い方を変えると、単純に横方向の速度と縦方向の速度を合成したものになります。同じく平面上に置くと下図のように四角形の上に並び、斜め方向は長い= 速さが大きいことになります。

f:id:eshamster:20180602145608p:plain:w450

物理的（？）にはどの方向にも等速で動く円形型が正しいですが、ゲームにおいてどちらが適しているかは場合によると思います。実際、斑鳩では後者の四角形型を採用しています。理由は推測するしかないですが、画面の広い範囲を動く傾向が強い斑鳩においては、速度を落とす選択肢を取りたくないといったことや、上下方向もしくは左右方向の速度は常に一定にしたいといったことなどが考えられそうです。

アナログスティックの挙動

本題のアナログスティックの挙動です。

特に弾幕系のような狭い隙間を正確に抜ける瞬間があるSTGでは、確実に真っ直ぐ動くことができるということは死活的に重要です。そのため、あえてアナログな挙動を突き詰める意味がない場合が多いと思われます。しかし、斑鳩というゲームにおいては数ドット単位での正確な立ち回り、という種類の精密さが求められることは皆無に等しく、そうした挙動を突き詰める余地があると言えます。それでも真っ直ぐに動けることの重要性は依然大きい訳ですが、XBLA版においてはこの辺りのバランスをきちんと詰めて来ました *3。

上下左右の移動

とりあえずは斜め方向は無視して、上下左右方向の移動がどうなっているかを見てみます。

ここで考えるべきことは単純で、例えば右なら右方向の速さを何段階に分けるかという点です。斑鳩において10段階や20段階に分けても嬉しくなさそうなことは直感的に想像できます。狙って速さを調整できる範囲を考えると、選択肢としては2段階～4段階程度が妥当と思われます。そして斑鳩では3段階を選んでいます*4。

f:id:eshamster:20180602184118p:plain:w450

調整の結果そうなったのだろう…だけでは詰まらないので少し理由を考えてみます。実際のところ、斑鳩ではほとんど3段階目=一番スティックを倒した状態しか使わないのですが、1段階目や2段階目にも特定の場面で使い所があります。それは敵レーザーに押されるときです。自機の最大速度はレーザーに押される速さより大きいので、アーケードスティック等で位置を維持するには細かくスティックを入れる・離すの繰り返しが必要になります。アナログスティックにおいてはその忙しさを解消しようとする意図が感じられます。特に1段階目は明らさまで、レーザーに押される速さと同じ速さに設定されています。そして2段階目はレーザーを僅かに押し返す速さに設定されています。こうした1段階目による静止、2段階目による微調整という辺りがアナログスティックで持ち込みたかった操作感なのかなと考えています。このためには、最低でも3段階が必要です。一方、これ以上細かく調整できても細か過ぎて有効には使えない…という辺りで3段階に落ち着いたように思います。

斜め方向の移動

ようやく冒頭のツイートで言及していた斜め方向の移動についての話題です。

8方向版を単純に拡張した場合の挙動

さて、アーケードスティックのような8方向の移動においては、斑鳩では単純に縦方向と横方向の合成して斜め方向の速度とする、四角形型のモデルを採用していました。一方、アナログスティックでの上下左右の移動としては、一方向に3段階の速さ持つ形を採用していました。ここでは、その2つを単純に組み合わせた場合に斜め移動がどうなるかを考えてみます。

斜め右上の方向について図にしてみます。

f:id:eshamster:20180602230416p:plain:w450

上方向に3段階、右方向に3段階あるため、これらを単純に組み合わせると、斜め方向の速度は3×3マスのグリッドの各頂点に相当します。したがって、スティックを目一杯倒して操作することを考えると、斜めには赤色の矢印で示した5方向に動けることになります。同じことが右下、左下、左上についても言えるので、斜めには5×4=20方向、これに上下左右を合わせて全部で24方向に動けます（無視した青い矢印も含めれば32方向）。

しかし、実装的には8方向版の自然な拡張であるこの挙動を、XBLA版斑鳩では採用していません。

実際の挙動

実際に採用されている挙動について、同じく斜め右上の方向を図示します。

f:id:eshamster:20180603013028p:plain:w450

先程と同様に計算すると、斜めには3×4=12方向、これに上下左右を合わせて全部で16方向となりました*5。結論だけを見ると元の8方向を2倍細かくしただけのように見えます。しかし、図を見ての通り、8方向で採用したモデル = 四角形型のモデルの単なる延長にあるものではないことから、明確な意図と綿密な調整の基に選びとられた仕様だと見るべきではないでしょうか。

これがいかに「自然」で馴染む操作になっているかの一つの証左として、（個人の感想でしかないですが…）少なくとも、自身はXBLA版をプレイしている最中にこの工夫に気づくことはなかった、ということを挙げたいと思います。同様の調整がなされていなかったSteam初期版を触って、初めてXBLA版での工夫に思い至ったのです。

終わりに

XBLAは海外で広く普及したハードであり、斑鳩を初めて触る人に届く可能性は大いに考えられたと思います。とすると、まずは手元の純正コントローラのアナログスティックで触ってみる人が多くいると想像できます。そのため、初対応で正解のない中で、アナログな挙動を突き詰めることには合理性があったのだと思います。

一方、Steam初期版は挙動が細か過ぎて真っ直ぐ進むことすら難しい（少なくとも自分の技量では）調整になってしまっていたことも、ある面では仕方のないものなのかと納得していました。というのは、パターンをNAOMI版に寄せることを優先していたように見えますし、複数解像度やキーボード操作への対応など泥くさい調整が多くあったようですし*6、またPCでは特定のコントローラを想定することが難しいため、アナログ挙動の調整の優先度が下がるのは止むを得ないと思えたからです。むしろ、アップデートによって、ニッチと思われる操作系を調整して頂けたのは大変ありがたいことだったと思っています。

あとは愚痴と妄想ですが、去る5月30日に販売の始まったNintendo Switch版、またもや真っ直ぐ進むことも難しい調整となっていました*7。Nintendo Switchの広まり方を考えれば、新たな客層にもそれなりに届くでしょうし、となるとまずは公式コントローラのアナログスティックでの操作が試みられるでしょう。そこに対してこの調整…。トレジャーはここ数年新作も移植も出しておらず、事実上解散状態にしか見えませんでしたが、余り深く考えないようにしてました。そして、移植とはいえ久々の作品で、優先しても良さそうなアナログスティックの操作、それもかつてはできていたもの、がおざなりな状態で出てきたのは、トレジャーの現状を突き付けてくるようで見るのが辛かったです。…というのが全部考え過ぎの妄想であればいいなと願っています。

→ 追記：8月8日配信のパッチでSwitch版にも調整が入りました。ありがとうございます！

*1: 2014年5月9日のアップデート後

*2:なお、XBLA版と修正後Steam版の挙動が同じ前提で書いていますが、きちんと裏を取っている訳ではないです…。実機確認はSteam版でやってます

*3:この辺りまで書いてから、そういえばDCやGCもアナログスティックついているけれど、アナログの挙動に対応していなかったのだろうか…とようやく疑問に思いました。実物を触ったことがないので確信を持てないのですが、一応ウィキペディアの記事を見る限りはXBLA版が初出のようですが

*4:なお、図では便宜上単純に3等分していますが、実際の速さはそうではないように思います

*5:青色の矢印で示した方向の速さが複数段階あるかは検証できていません

*6:参考: 『斑鳩』がSteamで近日配信　なぜいまSteamなのかをトレジャーに直撃 - ファミ通.com

*7:試した限り、上下左右方向が1つ増えて4段階で、しかもそれをそのまま斜めに拡張したように見えました

[Common Lisp] ros templateの紹介

Common Lisp プログラミング Lisp template Common Lisp-Roswell

cl-web-2d-game *1 のようなWebアプリ向けのライブラリなどを作っていると、使うまでに色々とサーバ側の設定コードが必要で、中々気軽にプロジェクトを起こせなかったりします（単にインタフェースが悪いのではという議論は置いておきます）。そうした課題の解決方法としてプロジェクトテンプレートがあると思います。Common Lispにも汎用的なものとしてはCL-Projectがありますし、WebフレームワークであるCaveman2にもテンプレート（skelton）が用意されています（CL-Projectベース）。ただ、自分で気軽にテンプレートを量産したり、もしくは人の書いた色々なテンプレートを使ったりしたいと思うと、テンプレートを統一的に管理する仕組みが欲しくなります。

そういうことをするのであればRoswellの周りだろう…と思って、まずは既存のテンプレートシステムがないのかと見てみると、ros templateというサブコマンドがあることが分かりました。ただ、ほぼアンドキュメントな状態で、ソースを見ながら使い方を探る必要がありました。また、使うにあたってこういう機能も欲しいというものもあったので、ポツポツとプルリク出したりしてました。その辺りも含めて使い方の紹介をする記事です。

目次

コマンドの一覧

ros templateコマンドの一覧は空でコマンドを打てば（もしくはros template helpで）下記のように見ることができます。他、ドキュメントとしてはdocuments/ros-template.mdがあります。プルリク出してクイックスタートを追加したので少し充実しました。

$ ros template
Usage: ros template [subcommand]
init            Create new template
deinit          Remove a template
list            List the installed templates
checkout        Checkout default template to edit.
add             Add files to template.
cat             Show file contents
edit            Edit file contents
rm              Remove (delete) files from template.
delete          Remove (delete) files from template.
type            Set template type for a file.
chmod           Set mode for a file.
rewrite         Set path rewrite rule for a file
export          Export template to directory
import          Import template
help            Print usage and subcommands description

なお、deinit, export, importは最近プルリクを入れてもらったものです。またeditも最近入ったものなので、これらの利用には最新版（master）が必要です。

基本的な利用方法

テンプレートの作成やテンプレートエンジンの適用方法など基本的な使い方を見ていきます。

テンプレートを作成する

まずはinitサブコマンドで空のテンプレートを作成します。

$ ros template init sample

特に出力はありませんが、checkoutサブコマンドを空で打ってみると確かに作成されていることが分かります。

$ ros template checkout
current default is "default"

candidates:
default
sample # ← これ

作成したテンプレートはros init <template名> <プロジェクト名>のようにして利用することができます。ただし、まだ空なので何もできません。

$ ros init sample some-project
; compiling file "/root/dev/roswell/lisp/util-template.lisp" (written 07 FEB 2018 11:55:59 AM):
# ～以下略～
$ ls
# まだ何もない

ファイルの追加

空のままではしょうがないので、ファイルの追加を行っていきます。

ほとんどのサブコマンドは第1引数に対象とするテンプレート名をとります。ただし、事前にcheckoutサブコマンドでテンプレートを指定しておくと第1引数を省略できます。例えば下記のようにすると、以降ファイルの追加や削除、その他の操作はsampleテンプレートに対してなされるようになります（なお、defaultテンプレートに実体はありません。したがってcurrent default is "default"は未選択と同義です）。

$ ros template checkout sample
$ ros template checkout # デフォルトがsampleになっていることを確認
current default is "sample"

candidates:
default
sample

次にファイルの追加ですが、ひとまず追加するファイルtestを適当に作っておきます。

$ echo "Hello Template!!" > test

addサブコマンドで今作ったファイルをテンプレートに追加します（フォルダの指定はできません）。

$ ros template add test

listサブコマンドでテンプレートの内部を概観してみます。すると、先ほど指定したtestが無事追加されていることが分かります。copyについては後で触れます。

$ ros template list
      copy  test

また、catサブコマンドで中を見てみると、確かに先ほど作成したファイルと同じ内容であることが分かります。

$ ros template cat test
Hello Template!!

さて、ここで改めてros initコマンドでテンプレートを起こしてみます。

$ mkdir sample
$ cd sample/
$ ros init sample some-project
$ ls
test
$ cat test
Hello Template!!

以上で、ひとまず自作テンプレートからプロジェクトを作成することができました。

テンプレート変数の利用

ファイルを追加して取り出せるようにはなったものの、変数を利用した部分的な書き換えることができないことにはテンプレート機構としては不十分です。

ros templateではDjulaをテンプレートエンジンとして利用した書き換えをサポートしています。Djulaは中々機能が豊富でほとんど把握できていないのですが…ここでは"{{ variable }}"といった形式で変数を埋め込むことができるという所だけ抑えておけば十分です。

ファイル名とファイル内容では変数の適用方法が異なるのでそれぞれ見ていきます。

ファイル名への変数適用：ros template rewrite

ファイル名については、rewriteサブコマンドを使うことで、リライトルールに変数を埋め込むことができます。

例えば、先ほどのtestというファイルを<プロジェクト名>.txtという形式で出力したい場合は次のように設定します。

$ ros template rewrite test "{{ name }}.txt"
$ ros template list # ルールが設定されていることの確認
      copy  test -> "{{ name }}.txt"

nameはデフォルトで利用可能な変数でros init <template> <project name>としたときに<project name>が入ります。デフォルトで利用できる変数は下記の4つです。

  • name: プロジェクト名
  • author: 作者名。git configから拾われます（なければ$(whoami)）
  • email: メールアドレス。git configから拾われます（なければ$(whoami)@$(hostname)）
  • get_universal_time: 実行時点の時間。[get-universal-time`](http://clhs.lisp.se/Body/f_get_un.htm)関数の結果です

さて、実際にros initすると、リライトルールに沿ってファイル名の書き換えが行われていることが分かります。なお、リライトルールにdoc/{{ name }}.txtのようにフォルダパスを含めると、フォルダを作成した上でその配下に置いてくれます。

# ※以降、ros initは適当な空ディレクトリで実行しているものとします
$ ros init sample sample-project
$ ls
sample-project.txt
$ cat sample-project.txt
Hello Template!!

ファイルの中身に対する変数適用：ros template type

次にファイルの中身での変数適用を見るため、まずはtestファイルを次の内容に更新しておきます。

$ cat<<EOF  > test
Hello {{ sample }}!!
name: {{ name }}
author: {{ author }}
email: {{ email }}
universal time: {{ universal_time }}
EOF
$ ros template add test # testファイルを上書き
$ ros template cat test
Hello {{ sample }}!!
name: {{ name }}
author: {{ author }}
email: {{ email }}
universal time: {{ universal_time }}

name, author, email, universal_timeは上記で触れたようにデフォルトの変数として利用できます。sampleのような独自の変数はros initの引数として--sample value（間に"="を入れるのはNG）のようにして指定できます（ファイルのリライトルールでも同じように独自の変数を利用できます）。

実際に試してみますが・・・

$ ros init sample some-project --sample Ikaruga
$ ros template cat test
Hello {{ sample }}!!
name: {{ name }}
author: {{ author }}
email: {{ email }}
universal time: {{ universal_time }}

このままでは変数は適用されません。ここで関係してくるのが、先ほどlistサブコマンドの表示の中で説明を飛ばしたcopyです。

$ ros template list
      copy  test -> "{{ name }}.txt"

これはtypeサブコマンドで指定できるもので、copyとdjulaの2種類があります。デフォルトのcopyはその名の通りファイルをそのままコピーします。一方のdjulaは、単にコピーするのではなくDjulaで処理をしたものを書き出します*2。

$ ros template type djula test
$ ros template list
      djula test -> "{{ name }}.txt"

この状態で改めてros initしてみると、意図通り変数の書き換えが行われました。

$ ros init sample some-project --sample Ikaruga
$ ros template cat test
Hello Ikaruga!!
name: some-project
author: eshamster
email: hamgoostar@gmail.com
universal time: 3727259379

なお、デフォルトのタイプはcopyになっていますが、テンプレートごとに変更することもできます。そのためには、typeサブコマンドにファイル名を与えずに実行します。設定したデフォルトタイプは、以降に新規追加するファイルに影響します*3。

$ ros template type # 引数なしで現在の設定を確認
current default type is "copy"
$ ros template type djula
$ ros template type
current default type is "djula"

テンプレートのエクスポート・インポート

ros templateは基本的にテンプレートの情報を内部的に管理するように作られています。そのため、Gitでテンプレートを管理したかったり、それを人に配布したかったりといった用途では少々不便です。そこで、テンプレートの実体をローカルに取り出したり、逆にローカルのテンプレートを一式取り込むためのサブコマンドが、exportやimportになります。

まず、exportサブコマンドは指定した（もしくはチェックアウトしている）テンプレートを一式ローカルフォルダに持ってきます。なお、同名のファイルが存在する場合は上書きします。一方で、テンプレート内に存在しないファイルがあった場合は単に無視します。

# 適当な空のディレクトリ
$ ros template checkout sample
$ ros template export
$ ls
roswell.init.sample.asd  test
$ cat test
Hello {{ sample }}!!
name: {{ name }}
author: {{ author }}
email: {{ email }}
universal time: {{ universal_time }}

sampleテンプレート内のファイルtestを取り出せたことが分かります。なお、roswell.init.sample.asdはテンプレートの管理実体 兼 作成スクリプト片です。中身は次のようになっていて、*params*内でパラメータリストとして様々な情報を管理しています。

$ cat roswell.init.sample.asd
(DEFPACKAGE :ROSWELL.INIT.SAMPLE
  (:USE :CL))
(IN-PACKAGE :ROSWELL.INIT.SAMPLE)
(DEFVAR *PARAMS*
  '(:COMMON (:DEFAULT-METHOD "djula") :FILES
    ((:NAME "test" :METHOD "djula" :REWRITE "{{ name }}.txt"))))
(DEFUN SAMPLE (_ &REST R)
  (ASDF/OPERATE:LOAD-SYSTEM :ROSWELL.UTIL.TEMPLATE :VERBOSE NIL)
  (FUNCALL (READ-FROM-STRING "roswell.util.template:template-apply") _ R
           *PARAMS*))

そして、importサブコマンドは指定されたフォルダ内のroswell.init.xxx.asdに従ってテンプレートを作成します。このとき、同名（名称はroswell.init.xxx.asdのxxxを抽出）のテンプレートがあった場合は上書きされるので注意が必要です。

# まだテンプレートがない別のマシンにexportしたファイルを持ってきた想定
$ ros template checkout
current default is "default"

candidates:
default
$ ls downloaded/
roswell.init.sample.asd  test
$ ros template import downloaded/
$ ros template list sample
0600  djula test -> "{{ name }}.txt"

このように、export, importサブコマンドを使うことで、自分で作ったテンプレートをGitで管理したり、人の作ったテンプレートを落としてきて試してみる、ということが（それなりに）気楽にできるようになりました。

その他

その他のコマンド

ここまでで説明していないコマンドには下記があります…が名前と説明からおおむね推測がつくと思いますので割愛します。

deinit          Remove a template
edit            Edit file contents
rm              Remove (delete) files from template.
delete          Remove (delete) files from template.
chmod           Set mode for a file.

余談：テンプレートの実体の管理場所

余談ですが、作成したテンプレートは~/.roswell/local-projects/templates/<テンプレート名>というフォルダで管理されます。

追加したファイルは同フォルダ内の<テンプレート名>-templateフォルダに入っています。下記のようにファイル名はエンコーディングされています。

$ ls -F ~/.roswell/local-projects/templates/sample/
roswell.init.sample.asd  sample-template/
$ ls ~/.roswell/local-projects/templates/sample/sample-template/
%38%2T%37%38
$ cat ~/.roswell/local-projects/templates/sample/sample-template/%38%2T%37%38
Hello {{ sample }}!!
name: {{ name }}
author: {{ author }}
email: {{ email }}
universal time: {{ universal_time }}

*1:まだREADMEすら書いていない…

*2:rewriteサブコマンドとは引数が逆順で少々戸惑いますが、rewriteは常に1ファイルずつ処理する、一方typeは複数を同時に処理する場合がある、ということによる差だと思われます

*3:デフォルトタイプの変更機能は最近プルリクしたものなので最新版が必要です

Common Lispでホットローディングを試しに作る (2) 実装について

Lisp Common Lisp プログラミング

前回記事ではCommon Lisp上で実現したホットローディングのプロトタイプのデモや使い方について見ました。

eshamster.hatenablog.com

今回はその実装についてです。といってもベースは実に単純なもので、ParenscriptによってCommon LispコードをJavaScriptに変換し、それをWebsocket Driverで立てたWebSocketサーバを通じてクライアント = ブラウザへ送るというだけです。ライブラリとして独立させる場合にサーバ部分のインタフェースをどうするか、という部分は当初ノーアイディアでひとまず動かすことを優先したのですが、最終的にはLackのミドルウェア（後述）として提供するのが良さそうだというところに落ち着いてます。

目次

コンパイラの実装（Parenscript）

Common LispコードからJavaScriptコードへのコンパイル部分は、基本的にParenscriptをそのまま使っているだけなので特筆すべきことはありません。WebSocketサーバの実装の部分で後述しますが、ライブラリとして分離させる際には消えてなくなりそうな部分です。

コード貼り付け：src/compiler.lisp

;; "((defvar x 100) (incf x))"
(defun compile-ps-string (str-code)
  (macroexpand `(ps:ps ,(read-from-string
                         (concatenate 'string "(progn " str-code ")")))))

;; '((defvar x 100) (incf x))
(defun convert-ps-s-expr-to-str (body)
  (format nil "~W" `(progn ,@body)))

;; '((defvar x 100) (incf x))
(defun compile-ps-s-expr (body)
  (compile-ps-string (convert-ps-s-expr-to-str body)))

サーバの実装

WebSocketサーバ

ブラウザへJavaScriptコードを送信する役割を担うWebSocketサーバの実装にはWebsocket Driverを利用しました。

まずはコード貼り付け：src/ws-server.lisp

(defvar *server-instance-list* nil)

(defparameter *ws-app*
  (lambda (env)
    (let ((server (make-server env)))
      (push server *server-instance-list*)
      (on :message server
          (lambda (ps-code)
            (format t "~&Server got: ~A~%" ps-code)
            (send-from-server ps-code)))
      (lambda (responder)
        (declare (ignore responder))
        (format t "~&Server connected")
        (start-connection server)))))

(defun send-from-server (ps-code)
  (let ((message (handler-case
                     (compile-ps-string ps-code)
                   (condition (e)
                     (declare (ignore e))
                     "alert(\"Compile Error!!\");"))))
    (dolist (server (copy-list *server-instance-list*))
      (case (ready-state server)
        (:open (send server message))
        (:closed (setf *server-instance-list* (remove server *server-instance-list*)))
        ;; otherwise do nothing
        ))))

*ws-app*がWebSocketサーバ本体で、(clack:clackup *ws-app*)のようにすれば単体で立ち上げることもできます。全体的には、WebSocketクライアントとの接続の管理と、送られてきたCommon Lisp（Parenscript）コードのコンパイルが役割です。

前者の接続管理としては、クライアントから新しい接続があったらmake-serverで新しくサーバを起こし、start-connectionで接続を開始します。一方、閉じられたサーバの掃除は送信時に実施します。send-from-serverでready-stateを見ているのがそれで、状態が:closedになっているサーバを除去しています。実を言うと、複数コネクションの管理方法がこれで正しいのか自信がないので、変なことをしていたら教えていただけると助かります…。

後者のコンパイル部分は、send-from-message内でmessageへの束縛を行っている部分です。単に上記のコンパイラを呼んでいるだけで、コンパイルエラーが起きた場合は雑にalertを返しています。

ところで、*ws-app*の定義で、(on :message ...)としてクライアントからの送信に反応するようにしています。クライアントから送られてきたCommon LispをJavaScriptにコンパイルして送り返すという内容です。これは前回少し触れた、下図白枠にCommon Lispコードを書いてボタンを押してサーバに送ると、JavaScriptとして送り返されて実行できる、という機能のためにあります。ホットローディングを実現する上では不要な部分で、実際にライブラリ化する際には除いてよいものです。その場合、send-from-message側でコンパイルをする必然性も薄くなり、同関数の利用者（後述のwith-hot-loads他）側からJavaScriptを渡すようにする方が良さそうです。すると、そちらではParenscriptを直接使えばよいので、上記のsrc/compiler.lisp部分はいらなくなる…といった話になってきます。

f:id:eshamster:20180203000537j:plain

ミドルウェア

ホットローディングライブラリとして見たとき、サーバ機能は上記の*ws-app*を直接見せるのではなく、それをラップしたLackのミドルウェアとして提供しています。

Lackにおけるミドルウェアは、定義上はアプリケーションを受け取ってアプリケーションを返す関数というシンプルなものです。これをWebアプリケーション本体の手前に挟み込むことで、ロギング機能を持たせたり静的ファイル配信機能を持たせたりできます。今回は、アプリケーションにホットローディング機能を持たせたいという話なので、ミドルウェアとして実装するのがピッタリではないかと思います。

なお、Lackにおけるアプリケーションも定義は大変シンプルで、各種HTTP情報がKey-Value形式（property list）で入ったenvを受け取って、決められたれ形式のレスポンスを返すというものです。*ws-app*もアプリケーションです。

コード貼り付け：src/middleware.lisp

(defun make-hot-load-middleware (&key main-js-path string-url)
  (lambda (app)
    (lambda (env)
      (create-js-file-if-required main-js-path)
      (let ((uri (getf env :request-uri)))
        (if (string= uri string-url)
            (funcall *ws-app* env)
            (funcall app env))))))

同ミドルウェアを作成する関数make-hot-load-middlewareの実装はこれだけです。主に2つのことをしています。一つは、アクセスがあった際にmake-js-pathで指定されたローカルファイルに、アクセス時点で定義済みのJavaScriptコードを書き出すこと（create-js-file-if-required：詳細後述）で、もう一つは、string-urlで指定されたURL情報をもとに、*ws-app*を呼び出してWebSocketを開くことです。

使い方の全体は前回記事参照ですが、例えば*static-app*というアプリケーションにホットローディング機能を持たせる場合、下記のように利用します。このとき、(start)としてサーバを開始した後、ws://localhost:5000/wsにアクセスすることでWebSocket通信を開くことができ、一方で/ws以外のアドレスにアクセスした場合は*static-app*側に処理が流れます。

(defun start (&key (port 5000))
  (clack:clackup
   (lack:builder (make-hot-load-middleware
                  :main-js-path (merge-pathnames
                                 "src/js/main.js"
                                 (asdf:component-pathname
                                  (asdf:find-system :proto-cl-hot-loads)))
                  :string-url "/ws")
                 *static-app*)
   :port port))

ホットローディング対象のコードを書くためのインタフェースの実装

ホットローディングなコードを書くためには、前回記事の使い方の章で述べたようにdefun.hlやdefvar.hl（hl = hot loads）といったマクロを利用します。これらを評価した時点で、関数や変数の新たな定義がWebSocketを通じてブラウザ側に送信されることになります。

また、一度評価した定義は環境中に残っており、新しく繋いできたブラウザに対しては一通りの定義を書き出したJavaScriptファイルを作成して送ります*1。

さて、defun.hlやdefvar.hlの基礎となっているのが、with-hot-loadsマクロです。

コード貼り付け：src/defines.lisp（※以降もこのソース）

(defmacro with-hot-loads ((&key label) &body body)
  `(progn (add-ps-def ',label ',body)
          (send-ps-code ',body)))

prognの中に書かれている2つの関数が上記で述べた役割をそれぞれ担っています。まずは、ホットローディングを担うsend-ps-codeを見ます。

(defun send-ps-code (body)
  (send-from-server (convert-ps-s-expr-to-str body)))

…これだけです。前述のようにsend-from-serverでは文字列で渡されたCommon LispコードをJavaScriptコードにコンパイルしてブラウザへ送信します。そのため、convert-ps-s-expr-to-strでbody（S式）を文字列に変換します。

次に、一度定義したものを覚えておいて、JavaScriptファイルに書き出す部分です。このうち、覚えておく部分がwith-hot-loadsで呼ばれているadd-ps-defになります。

(defstruct ps-def label def)
(defstruct ps-def-manager lst last-updated)

(defvar *ps-def-manager* (make-ps-def-manager))

(defun add-ps-def (label def)
  (check-type label symbol)
  (with-slots (lst last-updated) *ps-def-manager*
    (setf last-updated (get-universal-time))
    (let ((found (find-if
                  (lambda (ps-def) (eq label (ps-def-label ps-def)))
                  lst)))
      (if found
          (setf (ps-def-def found) def)
          (push (make-ps-def :label label :def def) lst)))))

シンボル（label）と定義（def）のペアをps-def構造体として作成し、それをps-def-managerにリスト*2として保存しておくという程度の関数です。ついでに、更新のあった時だけ書き出すということを実現するため、最終更新日時をlast-updatedに保存しています。

with-hot-loadsを利用する一例として、defun.hlの定義は下記のようになっています。関数名（シンボル）をラベル、defun以降全体を定義部分としています。

(defmacro defun.hl (name lambda-list &body body)
  `(with-hot-loads (:label ,name)
     (defun ,name ,lambda-list
       ,@body)))

こうして保管しておいた定義をファイルに書き出すのがcreate-js-file-if-requiredです。これは、ミドルウェアの中で利用した関数です。

(defun create-js-file-if-required (file-path)
  (check-type file-path pathname)
  (with-slots ((def-lst lst) last-updated) *ps-def-manager*
    (when (or (not (probe-file file-path))
              (< (file-write-date file-path) last-updated))
      (let ((dir (directory-namestring file-path)))
        (ensure-directories-exist dir)
        (with-open-file (file file-path
                              :direction :output
                              :if-exists :supersede
                              :if-does-not-exist :create)
          (dolist (def (reverse def-lst))
            (princ (compile-ps-s-expr (ps-def-def def)) file)
            (terpri file)))))))

更新日時を見て必要であれば、保管しておいた定義一通りをcompile-ps-s-exprでJavaScriptコードに変換してファイルに書き出すだけの関数です。

なお、同時実行を考慮していないので、同時に書き出すケースではおそらく死にます。

終わりに

以上、Common Lispでホットローディングのプロトタイプを作ってみました。核となる部分はシンプルなものでした。といっても、エラー処理やらの周辺を整えるのが大変なのでしょうね…。ホットローディング機能は欲しい場面もあるのですが、当面はプロトタイプのまま塩漬けになりそうです。

なお、今回はdefun.hl等を評価した時点で送信する方針をとりましたが、現実的にはファイルの更新を監視するClojureScriptのFigwheelのやり方が現実的だろうと思います。やはりファイル単位でないと、最適化やらパッケージングやら定義順序の保証が難しかったりするので。とはいえ、C-c C-cを押すだけで即座に送信される方が断然楽しいですし、SLIME上でのCommon Lisp開発により近いので悩ましくもあるのですが。

*1:正確には書き出すまでが役割で、ファイルを返すのはサーバ実装者の責務になっています

*2:なんでハッシュにしなかったんだっけ、と思いましたが、定義順を保存するためにリストにしたのでした