Windows上のClozure CLでasdf-install

Common Lisp

Windows上のClozure CLでasdf-installを使う方法について、先日のエントリのコメ欄で教えてもらった方法を試した。
http://d.hatena.ne.jp/t2ru/20100807/1281151524#c
意外に悶絶してしまったので、やり方を記録しておく。

~/ccl-init.lisp

;; asdf-installで使っているのに、CCLでは何故か入っていない。
(pushnew :win32 *features*)
(pushnew :mswindows *features*)

(require 'asdf)
(push "ccl:tools;asdf-install;" asdf:*central-registry*)

;; asdf-installでシンボリックリンクを貼れないので、パスをサーチするようにする。
(in-package #:asdf)
(defvar *subdir-search-registry*
  `(,(merge-pathnames ".asdf-install-dir/site/" (user-homedir-pathname))))
(defvar *subdir-search-wildcard* :wild)
(defun sysdef-subdir-search (system)
  (let ((latter-path (make-pathname :name (coerce-name system)
                                    :directory (list :relative *subdir-search-wildcard*)
                                    :type "asd"
                                    :version :newest
                                    :case :local)))
    (dolist (d *subdir-search-registry*)
      (let* ((wild-path (merge-pathnames latter-path d))
             (files (directory wild-path)))
        (when files
          (return (first files)))))))
(pushnew 'sysdef-subdir-search *system-definition-search-functions*)
(in-package #:cl-user)

asdf-install用に必要なパッケージを~/.ccl/startup/に手動で展開

  • gzip-stream
  • archive
  • trivial-gray-streams
  • flexi-streams
  • salza2

~/.asdf-install

;; asdf-installが使うパッケージは手動でロードできる状態にしておかないといけない。
(defparameter *asdf-startup-sites*
  (merge-pathnames ".ccl/startup/" (user-homedir-pathname)))

(dolist (p '("gzip-stream_0.2.8" "archive_0.8" "trivial-gray-streams-2008-11-02"
             "flexi-streams-1.0.7" "salza2-2.0.7"))
  (pushnew (merge-pathnames (concatenate 'string p "/") *asdf-startup-sites*)
           asdf:*central-registry*))

(asdf:oos 'asdf:load-op :gzip-stream)
(asdf:oos 'asdf:load-op :archive)

(defun asdf-install-extractor (to-dir tarball)
  (let ((name nil))
    (gzip-stream:with-open-gzip-file (ins tarball)
      (archive:with-open-archive (archive ins)
        (let ((*default-pathname-defaults* (pathname to-dir)))
          (archive:do-archive-entries (entry archive name)
            (archive:extract-entry archive entry)
            (unless name (setf name (archive:name entry)))))))
    ;; we use string instead of namestring because
    ;; asdf-install searches for /'s and not \'s
    ;; which will break on windows
    (string name)))

(push 'asdf-install-extractor asdf-install:*tar-extractors*)

;; suppress GPG checking
(setq asdf-install:*verify-gpg-signatures* nil)

これでasdf-installが動いた。