grovel/asdf.lisp

   1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; asdf.lisp --- ASDF components for cffi-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 #:cffi-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 (ignore 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: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   `(#-asdf3 (asdf:load-op ,@(asdf::component-load-dependencies c))
  72     #+asdf3 (asdf:prepare-op ,c)
  73     ,@(call-next-method)))
  74
  75 (defmethod asdf:component-depends-on ((op asdf:compile-op) (c process-op-input))
  76   (declare (ignore op))
  77   `((process-op ,(asdf:component-name c))
  78     ,@(call-next-method)))
  79
  80 (defmethod asdf:component-depends-on ((op asdf:load-source-op) (c process-op-input))
  81   (declare (ignore op))
  82   `((process-op ,(asdf:component-name c))
  83     ,@(call-next-method)))
  84
  85 (defmethod asdf:perform ((op asdf:compile-op) (c process-op-input))
  86   (let ((generated-lisp-file (first (asdf:output-files (make-instance 'process-op) c))))
  87     (asdf:perform op (make-instance 'asdf:cl-source-file
  88                                     :name (asdf:component-name c)
  89                                     :parent (asdf:component-parent c)
  90                                     :pathname generated-lisp-file))))
  91
  92 (defmethod asdf:perform ((op asdf:load-source-op) (c process-op-input))
  93   (let ((generated-lisp-file (first (asdf:output-files (make-instance 'process-op) c))))
  94     (asdf:perform op (make-instance 'asdf:cl-source-file
  95                                     :name (asdf:component-name c)
  96                                     :parent (asdf:component-parent c)
  97                                     :pathname generated-lisp-file))))
  98
  99 ;;;# ASDF component: GROVEL-FILE
 100
 101 (eval-when (:compile-toplevel :load-toplevel :execute)
 102   (defclass grovel-file (process-op-input cc-flags-mixin)
 103     ()
 104     (:default-initargs
 105      :generated-lisp-file-type "processed-grovel-file")
 106     (:documentation
 107      "This ASDF component represents an input file that is processed
 108      by PROCESS-GROVEL-FILE.")))
 109
 110 (defmethod asdf:output-files ((op process-op) (c grovel-file))
 111   (let* ((input-file (asdf:component-pathname c))
 112          (output-file (make-pathname :type (generated-lisp-file-type c)
 113                                      :defaults input-file))
 114          (c-file (make-c-file-name output-file)))
 115     (list output-file
 116           c-file
 117           (exe-filename c-file))))
 118
 119 (defmethod asdf:perform ((op process-op) (c grovel-file))
 120   (let ((output-file (first (asdf:output-files op c)))
 121         (input-file (asdf:component-pathname c)))
 122     (ensure-directories-exist (directory-namestring output-file))
 123     (let ((tmp-file (process-grovel-file input-file output-file)))
 124       (unwind-protect
 125            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
 126         (delete-file tmp-file)))))
 127
 128 ;;;# ASDF component: WRAPPER-FILE
 129
 130 (eval-when (:compile-toplevel :load-toplevel :execute)
 131   (defclass wrapper-file (process-op-input cc-flags-mixin)
 132     ((soname :initform nil :initarg :soname :accessor soname-of))
 133     (:default-initargs
 134      :generated-lisp-file-type "processed-wrapper-file")
 135     (:documentation
 136      "This ASDF component represents an input file that is processed
 137       by PROCESS-WRAPPER-FILE. This generates a foreign library and
 138       matching CFFI bindings that are subsequently compiled and
 139       loaded.")))
 140
 141 (defun wrapper-soname (c)
 142   (or (soname-of c)
 143       (asdf:component-name c)))
 144
 145 (defmethod asdf:output-files ((op process-op) (c wrapper-file))
 146   (let* ((input-file (asdf:component-pathname c))
 147          (output-file (make-pathname :type (generated-lisp-file-type c)
 148                                      :defaults input-file))
 149          (c-file (make-c-file-name output-file))
 150          (lib-soname (wrapper-soname c)))
 151     (list output-file
 152           c-file
 153           (lib-filename (make-soname lib-soname output-file)))))
 154
 155 (defmethod asdf:perform ((op process-op) (c wrapper-file))
 156   (let ((output-file (first (asdf:output-files op c)))
 157         (input-file  (asdf:component-pathname c)))
 158     (ensure-directories-exist (directory-namestring output-file))
 159     (let ((tmp-file (process-wrapper-file input-file output-file (wrapper-soname c))))
 160       (unwind-protect
 161            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
 162         (delete-file tmp-file)))))
 163
 164 ;; Allow for naked :grovel-file and :wrapper-file in asdf definitions.
 165 (eval-when (:compile-toplevel :load-toplevel :execute)
 166   (setf (find-class 'asdf::cffi-grovel-file) (find-class 'grovel-file))
 167   (setf (find-class 'asdf::cffi-wrapper-file) (find-class 'wrapper-file)))