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 :replace)
  47       (write-protobuf protobuf :stream stream :type :lisp)))
  48   lisp-file)