How to deliver a lib project which compile based configure file on Comon Lisp?

Viewed 77

Thanks to Common Lisp's powerful macro system, I can write lots of code template to generate functions avoid writing redundant code manually. What's more, it can generate different code based on configure file, so I can implement many kinds of feature just apply different configure file.

However, I have no idea how to deliver the project (It's a library):

In my opinion, maybe every config file corresponds to a package?

For example, there is a common lisp file common.lisp, it generate different functions based different configure file in compile-time. It reads a.conf in compile-time and generate functions for PackageA and reads config b.conf in compile-time for PackageB. But in-place statement must specify only one package, the common.lisp can't both in Package A and B.

By the way, I still can't find out a proper method to get the configure path of project (So I can read and use it in compile-time to generate functions) I have tried *load-truename* for it points to the cache path which contains .fasl file on SBCLv2.0.1. But it looks like the staic files are not contained in it, so it doesn't works.

2 Answers

For macro-expansion the thing you care about is compile time, not load time, and the variables you want are therefore *compile-file-pathname* &/or *compile-file-truename*. ASDF likes to stash compiled files (and hence the files being loaded) somewhere known to it, which you can turn off (I do) but defaultly they end up somewhere far from their sources.

Here's an example macro which should (I have not really tested it) let you enable debugging output on a per-file basis. In real life it would be better to cache the read of the config file/s but this is mildly fiddly to get right.

(declaim (inline mutter))

(defun mutter (format &rest arguments)
  (declare (ignore format arguments))
  (values))

(defmacro maybe-debugging (&body forms)
  (let ((config-file (and *compile-file-truename*
                          (make-pathname :name "debug"
                                         :type "cf"
                                         :defaults *compile-file-truename*))))
    (multiple-value-bind (debugging cond)
        (if (and config-file (probe-file config-file))
            (ignore-errors
              (with-standard-io-syntax
                (let ((*read-eval* nil))
                  (with-open-file (in config-file)
                    (values (assoc (pathname-name *compile-file-truename*)
                                   (read in)
                                   :test #'string-equal)
                            nil)))))
          (values nil nil))
      (when cond
        (warn "bogons reading ~A for ~A: ~A"
              config-file *compile-file-truename* cond))
      (if debugging
          `(flet ((mutter (format &rest arguments)
                    (apply #'format *debug-io* format arguments)))
             ,@forms)
        `(progn
          ,@forms)))))

For the single-source-file-resulting-in-multiple-object-files you could do something like this (note this repeats a variant of the above code):

(eval-when (:load-toplevel :compile-toplevel :execute)
  (defvar *package-compilation-configuration*
    nil
    "Compile-time configuration for a package")
  (defun package-config-value (key &optional (default nil))
    (getf *package-compilation-configuration* key default)))

(declaim (inline mutter))

(defun mutter (format &rest args)
  (declare (ignore format args))
  (values))

(defmacro with-muttering (&body forms)
  (if (package-config-value ':mutter)
      `(flet ((mutter (fmt &rest args)
                (apply #'format *debug-io* fmt args)))
         ,@forms)
    `(progn
       ,@forms)))

(defun compile-file-for-package (file package &rest kws
                                      &key (output-file nil output-file-p)
                                      &allow-other-keys)
  (with-muttering
    (let* ((sf-pathname (pathname file))
           (package-file (make-pathname :name (string package)
                                        :type "cf"
                                        :defaults sf-pathname))
           (the-output-file
            (if output-file-p
                output-file
              (compile-file-pathname
               (make-pathname :name (format nil "~A-~A"
                                            (pathname-name sf-pathname)
                                            package)
                              :defaults sf-pathname))))
           (*package-compilation-configuration*
            (if (probe-file package-file)
                (with-standard-io-syntax
                  (mutter "~&Compile ~A -> ~A using ~A~%"
                          sf-pathname the-output-file package-file)
                  (let ((*read-eval* nil))
                    (with-open-file (in package-file)
                      (read in))))
              (progn
                (mutter "~&Compile ~A -> ~A (no package)~%"
                        sf-pathname the-output-file)
                nil))))
      (apply #'compile-file file
             :output-file the-output-file
             kws))))

Then (compile-file-for-package "x.lisp" "y") will compile x.lisp having read configuration for package "y".

To use something like this in anger you would need to integrate it with ASDF and I don't know how to do that.

An alternative idea is just to use symlinks for the source files, and have the filename-dependent configuration depend on the symlink name, not the target name.

For my case:

project-a.asd:

(asdf:defsystem #:project-a
  :components ((:static-file "my-config-file.conf")
               (:static-file "common.lisp")  ; shared common lisp file

               (:file "project-a-package")
               (:file "project-a-setup")
               ;; other components
               )
  )

project-a-setup.lisp:

(in-package #:project-a)

(eval-when (:compile-toplevel)
  (defvar *mypackage* (find-package 'project-a))
  (defvar *source-home* (path:dirname *compile-file-truename*))

  ;; read configure file
  (defparameter *myconf*
     (with-open-file (stream (merge-pathnames *source-home* #P"my-config-file.conf"))
            (read stream)))
  )

(load (merge-pathnames *source-home* #P"common.lisp"))

common.lisp:

  (let ((*package* *mypackage*))
    ;; intern symbol 
      )
Related