requireのカスタムプロバイダ


lispにはrequireと言う関数があります。
モジュール名を指定することでそのモジュールをロードしてくれる、と言う関数です。

ちなみにrequire関数がモジュール名と実際にロードするファイルの関連付けする方法は処理系依存とのこと。自分はsbclでやったので他の処理系ではまた違う方法をとる必要があるとおもいます。

とりあえずはrequireの実装をみてみると・・・

(unless (member name *modules* :test #'string=)
  (cond (pathnames
	 (unless (listp pathnames) (setf pathnames (list pathnames)))
	 ;; ambiguity in standard: should we try all pathnames in the
	 ;; list, or should we stop as soon as one of them calls PROVIDE?
	 (dolist (ele pathnames t)
	   (load ele)))
	(t
	 (unless (some (lambda (p) (funcall p module-name))
		       *module-provider-functions*)
	   (require-error "Don't know how to ~S ~A."
			  'require module-name)))))

と言うコードがあります。
*modules*にすでにロードされたモジュールの一覧が入っているため、二度呼び出しても二重にロードされないようになっています。
condの一つ目のclosureはpathnamesが指定されていた場合なので今回は無視します。
二つ目のclosureが求めるところのようです。sbclの場合、sb-ext:*module-provider-functions*に入っている要素を一つずつ取り出してfuncallしています。
最終的にどのmodule-provider-functionもnon nilを返さなかった場合にrequire-errorとしています。
なので拡張する場合はsb-ext::*module-provider-functions*にモジュール名からloadする関数を用意してそれを登録してやればよさそうです。

そういうわけで作ってみたのが次の関数。

(require :cl-fad)
(defun my-module-provider-function (name)
  (let ((module-name (string-downcase (string name)))
	(dir (merge-pathnames (make-pathname
		      :directory '(:relative "source/vc/git/garbage/lisp"))
		     (user-homedir-pathname))))
    (let ((fasl-name (merge-pathnames 
		      (merge-pathnames 
		       (make-pathname :type sb-impl::*fasl-file-type*)
		       module-name) dir))
	  (lisp-name (merge-pathnames
		      (merge-pathnames 
		      (make-pathname :type "lisp")
		      module-name) dir))
	  (raw-name (merge-pathnames module-name dir)))
      (when (or (cl-fad:file-exists-p fasl-name)
		(cl-fad:file-exists-p lisp-name)
		(cl-fad:file-exists-p raw-name))
	(load raw-name)
	t))))

(push 'my-module-provider-function sb-ext:*module-provider-functions*)

自分の環境では ~/source/vc/git/garbage/lisplispコードをガシガシ書きなぐってるのでそこからloadしてくれると助かるのでそう作ってます。

で、このコードを ~/.sbclrcに書いておいて、slime起動させると・・・

; SLIME 2009-06-15
CL-USER> sb-ext:*module-provider-functions*
(MY-MODULE-PROVIDER-FUNCTION ASDF::MODULE-PROVIDE-ASDF
                             SB-IMPL::MODULE-PROVIDE-CONTRIB)

登録されています。

(defpackage :load-module-test
  (:use :cl)
  (:export :foo))

(in-package :load-module-test)

(defun foo ()
  (list :foo))

(provide :load-module-test)

テスト用に上記のコードを ~/source/vc/git/garbage/lisp/load-module-test.lisp として保存しておきます。

で、

CL-USER> *modules*
("SWANK-PRESENTATIONS" "SWANK-ARGLISTS" "SWANK-FANCY-INSPECTOR" "SWANK-FUZZY"
 "SWANK-C-P-C" "SWANK-PACKAGE-FU" "SWANK-ASDF" "SB-CLTL2" "SB-INTROSPECT"
 "SB-BSD-SOCKETS" "SB-EXECUTABLE" "SB-POSIX" "SB-GROVEL" "ASDF")
CL-USER> (require :load-module-test)
("LOAD-MODULE-TEST")
CL-USER> *modules*
("LOAD-MODULE-TEST" "SWANK-PRESENTATIONS" "SWANK-ARGLISTS"
 "SWANK-FANCY-INSPECTOR" "SWANK-FUZZY" "SWANK-C-P-C" "SWANK-PACKAGE-FU"
 "SWANK-ASDF" "SB-CLTL2" "SB-INTROSPECT" "SB-BSD-SOCKETS" "SB-EXECUTABLE"
 "SB-POSIX" "SB-GROVEL" "ASDF")
CL-USER> (load-module-test:foo)
(:FOO)
CL-USER> 

と、この様に自分の必要なカスタムプロバイダが提供できるようになりました。


ちなみに・・・sbclのドキュメントのhttp://www.sbcl.org/1.0/manual/Customization-Hooks-for-Users.htmlに載ってたりします。