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 (defclass cc-flags-mixin ()
  34   ((cc-flags :initform nil :accessor cc-flags-of :initarg :cc-flags)))
  35
  36 (defclass process-op (downward-operation)
  37   ()
  38   (:documentation "This ASDF operation performs the steps necessary
  39   to generate a compilable and loadable lisp file from a
  40   PROCESS-OP-INPUT component."))
  41
  42 (defclass process-op-input (cl-source-file)
  43   ((generated-lisp-file-type
  44     :initarg :generated-lisp-file-type
  45     :accessor generated-lisp-file-type
  46     :documentation "The :TYPE argument to use for the generated lisp file."))
  47   (:default-initargs
  48    :generated-lisp-file-type "generated-lisp-file")
  49   (:documentation "This ASDF component represents a file that is
  50     used as input to a function that generates lisp source file. This
  51     component acts as if it is a CL-SOURCE-FILE by applying the
  52     COMPILE-OP and LOAD-SOURCE-OP operations to the file generated by
  53     PROCESS-OP."))
  54
  55 (defmethod perform :around ((op process-op) (file cc-flags-mixin))
  56   (let ((*cc-flags* (append (ensure-list (cc-flags-of file))
  57                             *cc-flags*)))
  58     (call-next-method)))
  59
  60 (defmethod input-files ((op process-op) (c process-op-input))
  61   (list (component-pathname c)))
  62
  63 (defmethod input-files ((op compile-op) (c process-op-input))
  64   (list (first (output-files 'process-op c))))
  65
  66 (defmethod component-depends-on ((op process-op) (c process-op-input))
  67   `((prepare-op ,c) ,@(call-next-method)))
  68
  69 (defmethod component-depends-on ((op compile-op) (c process-op-input))
  70   `((process-op ,c) ,@(call-next-method)))
  71
  72 (defmethod component-depends-on ((op load-source-op) (c process-op-input))
  73   `((process-op ,c) ,@(call-next-method)))
  74
  75 ;;;# ASDF component: GROVEL-FILE
  76
  77 (defclass grovel-file (process-op-input cc-flags-mixin)
  78   ()
  79   (:default-initargs
  80    :generated-lisp-file-type "processed-grovel-file")
  81   (:documentation
  82    "This ASDF component represents an input file that is processed
  83     by PROCESS-GROVEL-FILE."))
  84
  85 (defmethod output-files ((op process-op) (c grovel-file))
  86   (let* ((input-file (first (input-files op c)))
  87          (output-file (make-pathname :type (generated-lisp-file-type c)
  88                                      :defaults input-file))
  89          (c-file (make-c-file-name output-file "__grovel")))
  90     (list output-file
  91           c-file
  92           (make-exe-file-name c-file))))
  93
  94 (defmethod perform ((op process-op) (c grovel-file))
  95   (let* ((output-file (first (output-files op c)))
  96          (input-file (first (input-files op c)))
  97          (tmp-file (process-grovel-file input-file output-file)))
  98     (rename-file-overwriting-target tmp-file output-file)))
  99
 100
 101 ;;;# ASDF component: WRAPPER-FILE
 102
 103 (defclass wrapper-file (process-op-input cc-flags-mixin)
 104   ((soname :initform nil :initarg :soname :accessor soname-of))
 105   (:default-initargs
 106    :generated-lisp-file-type "processed-wrapper-file")
 107   (:documentation
 108    "This ASDF component represents an input file that is processed
 109     by PROCESS-WRAPPER-FILE. This generates a foreign library and
 110     matching CFFI bindings that are subsequently compiled and
 111     loaded."))
 112
 113 (defun wrapper-soname (c)
 114   (or (soname-of c)
 115       (component-name c)))
 116
 117 (defmethod output-files ((op process-op) (c wrapper-file))
 118   (let* ((input-file (first (input-files op c)))
 119          (output-file (make-pathname :type (generated-lisp-file-type c)
 120                                      :defaults input-file))
 121          (c-file (make-c-file-name output-file "__wrapper"))
 122          (o-file (make-o-file-name output-file "__wrapper"))
 123          (lib-soname (wrapper-soname c)))
 124     (list output-file
 125           (make-so-file-name (make-soname lib-soname output-file))
 126           c-file
 127           o-file)))
 128
 129 ;;; Declare the .o and .so files as compilation outputs,
 130 ;;; so they get picked up by bundle operations.
 131 #.(when (version<= "3.1.6" (asdf-version))
 132     '(defmethod output-files ((op compile-op) (c wrapper-file))
 133       (destructuring-bind (generated-lisp lib-file c-file o-file) (output-files 'process-op c)
 134         (declare (ignore generated-lisp c-file))
 135         (multiple-value-bind (files translatedp) (call-next-method)
 136           (values (append files (list lib-file o-file)) translatedp)))))
 137
 138 (defmethod perform ((op process-op) (c wrapper-file))
 139   (let* ((output-file (first (output-files op c)))
 140          (input-file (first (input-files op c)))
 141          (tmp-file (process-wrapper-file
 142                     input-file
 143                     :output-defaults output-file
 144                     :lib-soname (wrapper-soname c))))
 145       (unwind-protect
 146            (alexandria:copy-file tmp-file output-file :if-to-exists :supersede)
 147         (delete-file tmp-file))))
 148
 149 ;; Allow for naked :cffi-grovel-file and :cffi-wrapper-file in asdf definitions.
 150 (setf (find-class 'asdf::cffi-grovel-file) (find-class 'grovel-file))
 151 (setf (find-class 'asdf::cffi-wrapper-file) (find-class 'wrapper-file))
 152