1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Free Software published under an MIT-like license. See LICENSE ;;;
5 ;;; Copyright (c) 2012 Google, Inc. All rights reserved. ;;;
7 ;;; Original author: Scott McKay ;;;
8 ;;; Based on work by: Robert Brown, Francois-Rene Rideau ;;;
10 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15 ;;; ASDF support for CL-Protobufs
17 (defclass protobuf-file (cl-source-file)
18 ((type :initform "proto") ;default file type
19 ;; If non-nil, use this relative pathname
20 (proto-pathname :accessor proto-relative-pathname
22 :initarg :proto-pathname
23 :documentation "Relative pathname giving the location of the .proto file")
24 ;; A search path to try when looking for system-provided .proto files
25 (search-path :accessor proto-search-path
29 "List of directories where the protocol buffer compiler should search
30 for imported protobuf files. Relative pathnames are treated as relative
31 to the directory containing the DEFSYSTEM form in which they appear.")
32 (conc-name :accessor proto-conc-name
36 "This ASDF component defines PROTO-TO-LISP, COMPILE-OP and LOAD-OP
37 operations that compile the .proto file into a .lisp file. The .lisp
38 file is then compiled, and possibly loaded, as well."))
40 (defclass proto-to-lisp (compile-op) ()
42 "The ASDF operation that compiles a .proto file containing Protocol Buffers
43 definitions into a .lisp source file."))
45 (defmethod component-depends-on ((op compile-op) (component protobuf-file))
46 "Compiling a protocol buffer file depends on generating Lisp source code for it."
47 (if (typep op 'proto-to-lisp)
49 `((proto-to-lisp ,(component-name component))
50 ,@(call-next-method))))
52 (defmethod component-depends-on ((op load-op) (component protobuf-file))
53 "Loading a protocol buffer file depends on generating Lisp source code for it."
54 `((proto-to-lisp ,(component-name component))
55 ,@(call-next-method)))
57 (defmethod component-self-dependencies :around ((op load-op) (component protobuf-file))
58 (remove-if #'(lambda (x)
59 (eq (car x) 'proto-to-lisp))
62 (defun protobuf-input-file (component)
63 "Returns the pathname of the protocol buffer definition file that must be
64 translated into Lisp source code for this PROTO-FILE component."
65 (check-type component protobuf-file)
66 (if (proto-relative-pathname component)
67 ;; Path was specified with ':proto-pathname'
68 (subpathname (component-pathname (component-parent component))
69 (proto-relative-pathname component)
71 ;; No ':proto-pathname', the path of the protobuf file
72 ;; defaults to the component-pathname, with its automatic type "proto"
73 (component-pathname component)))
75 (defun resolve-search-path (component)
76 (check-type component protobuf-file)
77 (let* ((search-path (proto-search-path component))
78 (parent-path (component-pathname (component-parent component))))
79 (mapcar #'(lambda (path)
80 (resolve-relative-pathname path parent-path))
83 (defun resolve-relative-pathname (path parent-path)
84 "When 'path' doesn't have an absolute directory component,
85 treat it as relative to 'parent-path'."
86 (pathname-directory-pathname
87 (merge-pathnames* path parent-path)))
89 (defmethod input-files ((op proto-to-lisp) (component protobuf-file))
90 "The input file is just the .proto file."
91 (declare (ignorable op))
92 (list (protobuf-input-file component)))
94 (defmethod output-files ((op proto-to-lisp) (component protobuf-file))
95 "The output file is a lisp file, stored where .fasl files are stored."
96 (declare (ignorable op))
97 (values (list (lispize-pathname (component-pathname component))) nil))
99 (defmethod input-files ((op compile-op) (component protobuf-file))
100 "The input files are the .lisp and .proto-imports files."
101 (declare (ignorable op))
102 (output-files (make-instance 'proto-to-lisp) component))
104 (defmethod perform ((op proto-to-lisp) (component protobuf-file))
105 (let* ((input (protobuf-input-file component))
106 (output (output-file op component))
107 (paths (cons (directory-namestring input) (resolve-search-path component)))
108 (proto-impl:*protobuf-search-path* paths)
109 (proto-impl:*protobuf-output-path* output))
110 (dolist (path paths (error 'compile-failed
111 :component component :operation op))
112 (let ((proto (make-pathname :type "proto" :defaults (merge-pathnames* path (pathname input))))
113 (lisp (output-file op component)))
114 (when (probe-file proto)
116 (proto-impl:parse-protobuf-file proto lisp
117 :conc-name (proto-conc-name component))))))))
119 (defmethod operation-description ((op proto-to-lisp) (component protobuf-file))
120 (format nil (compatfmt "~@<proto-compiling ~3i~_~A~@:>")
121 (first (input-files op component))))
123 (defmethod perform ((op compile-op) (component protobuf-file))
124 (let* ((input (protobuf-input-file component))
125 (output (output-file op component))
126 (lisp (first (input-files op component)))
128 (paths (cons (directory-namestring input) (resolve-search-path component)))
129 (proto-impl:*protobuf-search-path* paths)
130 (proto-impl:*protobuf-output-path* output)
131 (*compile-file-warnings-behaviour* (operation-on-warnings op))
132 (*compile-file-failure-behaviour* (operation-on-failure op)))
133 (multiple-value-bind (output warnings-p failure-p)
134 (apply #'compile-file* lisp
136 (compile-op-flags op))
138 (case (operation-on-warnings op)
139 (:warn (warn "~@<COMPILE-FILE warned while performing ~A on ~A.~@:>" op component))
140 (:error (error 'compile-warned
141 :component component :operation op))
144 (case (operation-on-failure op)
145 (:warn (warn "~@<COMPILE-FILE failed while performing ~A on ~A.~@:>" op component))
146 (:error (error 'compile-failed
147 :component component :operation op))
150 (error 'compile-error
151 :component component :operation op)))))
153 (defmethod operation-description ((op compile-op) (component protobuf-file))
154 (format nil (compatfmt "~@<compiling ~3i~_~A~@:>")
155 (first (input-files op component))))
158 ;;; Processing of imports
160 (in-package "PROTO-IMPL")
162 (defun parse-protobuf-file (protobuf-file lisp-file &key (conc-name ""))
163 (let ((schema (parse-schema-from-file protobuf-file :conc-name conc-name)))
164 (with-open-file (stream lisp-file
166 :if-exists :supersede
167 :external-format :utf-8
168 :element-type 'character)
169 (write-schema schema :stream stream :type :lisp)))
172 ;; Process 'import' lines
173 (defun process-imports (schema imports
174 &key (search-path *protobuf-search-path*)
175 (output-path *protobuf-output-path*))
176 "Imports all of the files given by 'imports'.
177 If the file is a .proto file, it first parses it and writes a .lisp file.
178 The .lisp file is the compiled and loaded."
179 (dolist (import imports)
181 (let* ((import (pathname import))
182 (import-name (pathname-name import))
183 (imported (find-schema (class-name->proto import-name))))
184 ;; If this schema has already been imported somewhere else,
185 ;; mark it as imported here and carry on
187 (setf (proto-imported-schemas schema)
188 (nconc (proto-imported-schemas schema) (list imported)))
189 (return-from import-one))
190 (dolist (path search-path (error "Could not import ~S" import))
191 (let* ((base-path (asdf::merge-pathnames* import path))
192 (proto-file (make-pathname :name import-name :type "proto"
193 :defaults base-path))
194 (lisp-file (asdf::lispize-pathname
196 (make-pathname :name import-name
197 :directory (pathname-directory output-path))
199 (fasl-file (compile-file-pathname lisp-file))
200 (asdf:*asdf-verbose* nil) ;for safe-file-write-date
201 (proto-date (asdf::safe-file-write-date proto-file))
202 (lisp-date (asdf::safe-file-write-date lisp-file))
203 (fasl-date (asdf::safe-file-write-date fasl-file)))
204 (when (probe-file proto-file)
205 (let ((*protobuf-pathname* proto-file))
206 (when (string= (pathname-type base-path) "proto")
207 ;; The user asked to import a .proto file
208 ;; If there's no .lisp file or an older .lisp file, parse the .proto file now
209 (cond ((not proto-date)
210 (warn "Could not find the .proto file to be imported: ~A" proto-file))
212 (< lisp-date proto-date))
213 (parse-protobuf-file proto-file lisp-file)
214 (setq lisp-date (file-write-date lisp-file)))))
215 ;; Compile the .lisp file, if necessary
216 (cond ((not lisp-date)
217 (unless (string= (pathname-type base-path) "proto")
218 (warn "Could not find the .lisp file to be compiled: ~A" lisp-file)))
220 (when (or (not fasl-date)
221 (< fasl-date lisp-date))
222 (let ((*compile-file-pathname* lisp-file)
223 (*load-pathname* nil))
224 (setq fasl-file (compile-file lisp-file)))
225 (setq fasl-date (file-write-date fasl-file)))
226 ;; Now we can load the .fasl file
227 (let ((*compile-file-pathname* nil)
228 (*load-pathname* fasl-file))
230 (let* ((imported (find-schema (class-name->proto import-name))))
232 (setf (proto-imported-schemas schema)
233 (nconc (proto-imported-schemas schema) (list imported))))
234 (return-from import-one)))))))))