asdf-support.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Confidential and proprietary information of ITA Software, Inc.   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 ITA Software, Inc.  All rights reserved.      ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Francois-Rene Rideau, Scott McKay               ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-IMPL")
  12
  13
  14 (eval-when (:compile-toplevel :load-toplevel :execute)
  15
  16 (defclass proto-file (asdf:cl-source-file)
  17   ((asdf::type :initform "proto"))
  18   (:documentation
  19    "This ASDF component defines COMPILE-OP and LOAD-OP operations
  20     that compiles the .proto file into a .lisp file, and the compiles
  21     the resulting .lisp file into a fasl."))
  22
  23 )       ;eval-when
  24
  25 (defmethod asdf:output-files ((op asdf:compile-op) (c proto-file))
  26   (append (call-next-method)
  27           (make-pathname :type "lisp" :defaults (asdf:component-pathname c))))
  28
  29 (defmethod asdf:perform ((op asdf:compile-op) (c proto-file))
  30   (destructuring-bind (fasl-file lisp-file)
  31       (asdf:output-files op c)
  32     (funcall asdf::*compile-op-compile-file-function*
  33              (parse-protobuf-file (asdf:component-pathname c) lisp-file)
  34              :output-file fasl-file)))
  35
  36 (defmethod asdf:perform ((op asdf:load-source-op) (c proto-file))
  37   (destructuring-bind (fasl-file lisp-file)
  38       (asdf:output-files op c)
  39     (declare (ignore fasl-file))
  40     (load (parse-protobuf-file (asdf:component-pathname c) lisp-file))))
  41
  42 (defun parse-protobuf-file (proto-file lisp-file)
  43   (let ((protobuf (parse-protobuf-from-file proto-file)))
  44     (with-open-file (stream lisp-file
  45                      :direction :output
  46                      :if-exists :supersede)
  47       (write-protobuf protobuf :stream stream :type :lisp)))
  48   lisp-file)
  49
  50
  51 ;; Process 'import' lines
  52 (defun process-imports (&rest imports)
  53   "Imports all of the files given by 'imports'.
  54    If the file is a .proto file, it first parses it and writes a .lisp file.
  55    The .lisp file is the compiled and loaded."
  56   (dolist (import imports)
  57     (let* ((base-file  (pathname import))
  58            (proto-file (make-pathname :type "proto" :defaults base-file))
  59            (lisp-file  (make-pathname :name (pathname-name base-file) :type "lisp"
  60                                       :defaults (or *compile-file-pathname* base-file)))
  61            (fasl-file  (compile-file-pathname lisp-file))
  62            (proto-date (and (probe-file proto-file)
  63                             (ignore-errors (file-write-date proto-file))))
  64            (lisp-date  (and (probe-file lisp-file)
  65                             (ignore-errors (file-write-date lisp-file))))
  66            (fasl-date  (and (probe-file fasl-file)
  67                             (ignore-errors (file-write-date fasl-file)))))
  68       (when (string= (pathname-type base-file) "proto")
  69         ;; The user asked to import a .proto file
  70         ;; If there's no .lisp file or an older .lisp file, parse the .proto file now
  71         (cond ((not proto-date)
  72                (warn "Could not find the file to be imported ~A" proto-file))
  73               ((or (not lisp-date)
  74                    (< lisp-date proto-date))
  75                (parse-protobuf-file proto-file lisp-file)
  76                (setq lisp-date (file-write-date lisp-file)))))
  77       ;; Compile the .lisp file, if necessary
  78       (cond ((not lisp-date)
  79              (unless (string= (pathname-type base-file) "proto")
  80                (warn "Could not find the file to be imported ~A" proto-file)))
  81             (t
  82              (when (or (not fasl-date)
  83                        (< fasl-date lisp-date))
  84                (setq fasl-file (compile-file lisp-file))
  85                (setq fasl-date (file-write-date fasl-file)))
  86              ;; Now we can load the .fasl file
  87              (load fasl-file))))))