src/grovel/asdf.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; asdf.lisp --- ASDF components for iolib-grovel.
   4 ;;;
   5 ;;; Copyright (C) 2005-2006, Dan Knap <dankna@accela.net>
   6 ;;; Copyright (C) 2005-2006, Emily Backes <lucca@accela.net>
   7 ;;; Copyright (C) 2007, Stelian Ionescu <sionescu@cddr.org>
   8 ;;; Copyright (C) 2007, Luis Oliveira <loliveira@common-lisp.net>
   9 ;;;
  10 ;;; Permission is hereby granted, free of charge, to any person
  11 ;;; obtaining a copy of this software and associated documentation
  12 ;;; files (the "Software"), to deal in the Software without
  13 ;;; restriction, including without limitation the rights to use, copy,
  14 ;;; modify, merge, publish, distribute, sublicense, and/or sell copies
  15 ;;; of the Software, and to permit persons to whom the Software is
  16 ;;; furnished to do so, subject to the following conditions:
  17 ;;;
  18 ;;; The above copyright notice and this permission notice shall be
  19 ;;; included in all copies or substantial portions of the Software.
  20 ;;;
  21 ;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  22 ;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
  23 ;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  24 ;;; NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  25 ;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  26 ;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  27 ;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
  28 ;;; DEALINGS IN THE SOFTWARE.
  29 ;;;
  30
  31 (in-package :iolib/grovel)
  32
  33 (defun ensure-pathname (thing)
  34   (if (typep thing 'logical-pathname)
  35       (translate-logical-pathname thing)
  36       (pathname thing)))
  37
  38 (defclass cc-flags-mixin ()
  39   ((cc-flags :initform nil :accessor cc-flags-of :initarg :cc-flags)))
  40
  41 (defmethod asdf:perform :around ((op asdf:compile-op) (file cc-flags-mixin))
  42   (declare (ignorable op))
  43   (let ((*cc-flags* (append (ensure-list (cc-flags-of file))
  44                             *cc-flags*)))
  45     (call-next-method)))
  46
  47 (eval-when (:compile-toplevel :load-toplevel :execute)
  48   (defclass process-op (asdf:downward-operation)
  49     ()
  50     (:documentation "This ASDF operation performs the steps necessary
  51   to generate a compilable and loadable lisp file from a
  52   PROCESS-OP-INPUT component."))
  53
  54   (defclass process-op-input (asdf:cl-source-file)
  55     ((generated-lisp-file-type
  56       :initarg :generated-lisp-file-type
  57       :accessor generated-lisp-file-type
  58       :documentation "The :TYPE argument to use for the generated lisp file."))
  59     (:default-initargs
  60      :generated-lisp-file-type "generated-lisp-file")
  61     (:documentation "This ASDF component represents a file that is
  62     used as input to a function that generates lisp source file. This
  63     component acts as if it is a CL-SOURCE-FILE by applying the
  64     COMPILE-OP and LOAD-SOURCE-OP operations to the file generated by
  65     PROCESS-OP.")))
  66
  67 (defmethod asdf:input-files ((op process-op) (c process-op-input))
  68   (list (asdf:component-pathname c)))
  69
  70 (defmethod asdf:component-depends-on ((op process-op) (c process-op-input))
  71   `((asdf:prepare-op ,c)
  72     ,@(call-next-method)))
  73
  74 (defmethod asdf:component-depends-on ((op asdf:compile-op) (c process-op-input))
  75   (declare (ignorable op))
  76   `((process-op ,(asdf:component-name c))
  77     ,@(call-next-method)))
  78
  79 (defmethod asdf:component-depends-on ((op asdf:load-source-op) (c process-op-input))
  80   (declare (ignorable op))
  81   `((process-op ,(asdf:component-name c))
  82     ,@(call-next-method)))
  83
  84 (defmethod asdf:perform ((op asdf:compile-op) (c process-op-input))
  85   (let ((generated-lisp-file (first (asdf:output-files (make-instance 'process-op) c))))
  86     (asdf:perform op (make-instance 'asdf:cl-source-file
  87                                     :name (asdf:component-name c)
  88                                     :parent (asdf:component-parent c)
  89                                     :pathname generated-lisp-file))))
  90
  91 (defmethod asdf:perform ((op asdf:load-source-op) (c process-op-input))
  92   (let ((generated-lisp-file (first (asdf:output-files (make-instance 'process-op) c))))
  93     (asdf:perform op (make-instance 'asdf:cl-source-file
  94                                     :name (asdf:component-name c)
  95                                     :parent (asdf:component-parent c)
  96                                     :pathname generated-lisp-file))))
  97
  98 ;;;# ASDF component: GROVEL-FILE
  99
 100 (eval-when (:compile-toplevel :load-toplevel :execute)
 101   (defclass grovel-file (process-op-input cc-flags-mixin)
 102     ()
 103     (:default-initargs
 104      :generated-lisp-file-type "processed-grovel-file")
 105     (:documentation
 106      "This ASDF component represents an input file that is processed
 107      by PROCESS-GROVEL-FILE.")))
 108
 109 (defmethod asdf:output-files ((op process-op) (c grovel-file))
 110   (let* ((input-file (asdf:component-pathname c))
 111          (output-file (make-pathname :type (generated-lisp-file-type c)
 112                                      :defaults input-file))
 113          (c-file (make-c-file-name output-file)))
 114     (list output-file
 115           c-file
 116           (exe-filename c-file))))
 117
 118 (defmethod asdf:perform ((op process-op) (c grovel-file))
 119   (let ((output-file (first (asdf:output-files op c)))
 120         (input-file (asdf:component-pathname c)))
 121     (ensure-directories-exist (directory-namestring output-file))
 122     (let ((tmp-file (process-grovel-file input-file output-file)))
 123       (unwind-protect
 124            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
 125         (delete-file tmp-file)))))
 126
 127 ;;;# ASDF component: WRAPPER-FILE
 128
 129 (eval-when (:compile-toplevel :load-toplevel :execute)
 130   (defclass wrapper-file (process-op-input cc-flags-mixin)
 131     ((soname :initform nil :initarg :soname :accessor soname-of))
 132     (:default-initargs
 133      :generated-lisp-file-type "processed-wrapper-file")
 134     (:documentation
 135      "This ASDF component represents an input file that is processed
 136       by PROCESS-WRAPPER-FILE. This generates a foreign library and
 137       matching CFFI bindings that are subsequently compiled and
 138       loaded.")))
 139
 140 (defun wrapper-soname (c)
 141   (or (soname-of c)
 142       (asdf:component-name c)))
 143
 144 (defmethod asdf:output-files ((op process-op) (c wrapper-file))
 145   (let* ((input-file (asdf:component-pathname c))
 146          (output-file (make-pathname :type (generated-lisp-file-type c)
 147                                      :defaults input-file))
 148          (c-file (make-c-file-name output-file))
 149          (lib-soname (wrapper-soname c)))
 150     (list output-file
 151           c-file
 152           (lib-filename (make-soname lib-soname output-file)))))
 153
 154 (defmethod asdf:perform ((op process-op) (c wrapper-file))
 155   (let ((output-file (first (asdf:output-files op c)))
 156         (input-file  (asdf:component-pathname c)))
 157     (ensure-directories-exist (directory-namestring output-file))
 158     (let ((tmp-file (process-wrapper-file input-file output-file (wrapper-soname c))))
 159       (unwind-protect
 160            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
 161         (delete-file tmp-file)))))
 162
 163 ;; Allow for naked :grovel-file and :wrapper-file in asdf definitions.
 164 (eval-when (:compile-toplevel :load-toplevel :execute)
 165   (setf (find-class 'asdf::iolib-grovel-file) (find-class 'grovel-file))
 166   (setf (find-class 'asdf::iolib-wrapper-file) (find-class 'wrapper-file)))