3 ;;; Modules and module parser
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Simple Object Definition system.
12 ;;; SOD is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; SOD is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with SOD; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
28 ;;;--------------------------------------------------------------------------
31 (defparameter *module-dirs* nil
32 "A list of directories (as pathname designators) to search for files.
34 Both SOD module files and Lisp extension files are searched for in this
35 list. The search works by merging the requested pathname with each
36 element of this list in turn. The list is prefixed by the pathname of the
37 requesting file, so that it can refer to other files relative to wherever
40 See FIND-FILE for the grubby details.")
42 (defun find-file (lexer name what thunk)
43 "Find a file called NAME on the module search path, and call THUNK on it.
45 The file is searched for relative to the LEXER's current file, and also in
46 the directories mentioned in the *MODULE-DIRS* list. If the file is
47 found, then THUNK is invoked with two arguments: the name we used to find
48 it (which might be relative to the starting directory) and the truename
51 If the file wasn't found, or there was some kind of error, then an error
52 is signalled; WHAT should be a noun phrase describing the kind of thing we
53 were looking for, suitable for inclusion in the error message.
55 While FIND-FILE establishes condition handlers for its own purposes, THUNK
56 is not invoked with any additional handlers defined."
59 (dolist (dir (cons (stream-pathname (lexer-stream lexer))
62 (let* ((path (merge-pathnames name dir))
63 (probe (probe-file path)))
65 (return (values path probe)))))
67 (error "Error searching for ~A ~S: ~A" what (namestring name) error))
68 (:no-error (path probe)
70 (error "Failed to find ~A ~S" what name))
72 (funcall thunk path probe))))))
74 ;;;--------------------------------------------------------------------------
80 :accessor module-name)
84 :accessor module-plist)
85 (classes :initform nil
88 :accessor module-classes)
89 (source-fragments :initform nil
90 :initarg :source-fragments
92 :accessor module-source-fragments)
93 (header-fragments :initform nil
94 :initarg :header-fragments
96 :accessor module-header-fragments)
97 (dependencies :initform nil
98 :initarg :dependencies
100 :accessor module-dependencies))
102 "A module is a container for the definitions made in a source file.
104 Modules are the fundamental units of translation. The main job of a
105 module is to remember which definitions it contains, so that they can be
106 translated and written to output files. The module contains the following
107 handy bits of information:
109 * A (path) name, which is the filename we used to find it. The default
110 output filenames are derived from this. (We use the file's truename
111 as the hash key to prevent multiple inclusion, and that's a different
114 * A property list containing other useful things.
116 * A list of the classes defined in the source file.
118 * Lists of C fragments to be included in the output header and C source
121 * A list of other modules that this one depends on.
123 Modules are usually constructed by the PARSE-MODULE function, which is in
124 turn usually invoked by IMPORT-MODULE, though there's nothing to stop
125 fancy extensions building modules programmatically."))
127 (defun import-module (pathname &key (truename (truename pathname)))
130 The module is returned if all went well; NIL is returned if an error
133 The PATHNAME argument is the file to read. TRUENAME should be the file's
134 truename, if known: often, the file will have been searched for using
135 PROBE-FILE or similar, which drops the truename into your lap."
137 (let ((module (gethash truename *module-map*)))
140 ;; The module's not there. (The *MODULE-MAP* never maps things to
144 ;; Mark the module as being in progress. Another attempt to import it
146 (setf (gethash truename *module-map*) :in-progress)
148 ;; Be careful to restore the state of the module map on exit.
151 ;; Open the module file and parse it.
152 (with-open-file (f-stream pathname :direction :input)
153 (let* ((pai-stream (make-instance 'position-aware-input-stream
156 (lexer (make-instance 'sod-lexer :stream pai-stream)))
157 (with-default-error-location (lexer)
162 (setf module (parse-module lexer)))
164 :report "Ignore the import and continue"
167 ;; If we successfully parsed the module, then store it in the table;
168 ;; otherwise remove it because we might want to try again. (That
169 ;; might not work very well, but it could be worth a shot.)
171 (setf (gethash truename *module-map*) module)
172 (remhash truename *module-map*))))
174 ;; A module which is being read can't be included again.
175 ((eql module :in-progress)
176 (error "Cyclic module dependency involving module ~A" pathname))
178 ;; A module which was successfully read. Just return it.
182 (defun parse-module (lexer)
183 "Parse a module from the given LEXER.
185 The newly constructed module is returned. This is the top-level parsing
194 (labels ((fragment (func)
196 (when (require-token lexer #\{ :consumep nil)
197 (let ((frag (scan-c-fragment lexer '(#\}))))
199 (require-token lexer #\})
200 (funcall func frag)))))
205 ;; module : empty | module-def module
207 ;; Just read module-defs until we reach the end of the file.
208 (case (token-type lexer)
216 ;; module-def : `import' string `;'
218 ;; Read another module of definitions from a file.
221 (let ((name (require-token lexer :string)))
224 (merge-pathnames name (make-pathname
230 (let ((module (import-module path
235 (cerror* "Error reading module ~S: ~A"
239 ;; module-def : `load' string `;'
241 ;; Load a Lisp extension from a file.
244 (let ((name (require-token lexer :string)))
247 (merge-pathnames name
248 (make-pathname :type "LISP"
252 (handler-case (load true
256 (cerror* "Error loading Lisp file ~S: ~A"
260 ;; module-def : `lisp' sexp
262 ;; Process an in-line Lisp form immediately.
264 (let ((form (with-lexer-stream (stream lexer)
269 (cerror* "Error in Lisp form: ~A" error))))
273 ;; module-def : `typename' ids `;'
274 ;; ids : id | ids `,' id
276 ;; Add ids as registered type names. We don't need to know what
277 ;; they mean at this level.
281 (let ((id (require-token lexer :id)))
284 ((gethash id *type-map*)
285 (cerror* "Type ~A is already defined" id))
287 (setf (gethash id *type-map*)
288 (make-instance 'simple-c-type :name id))))
289 (unless (eql (token-type lexer) #\,)
294 ;; module-def : `source' `{' c-stuff `}'
295 ;; module-def : `header' `{' c-stuff `}'
297 (fragment (lambda (frag) (push frag cfrags)))
300 (fragment (lambda (frag) (push frag hfrags)))
303 ;; Anything else is an error.
305 (cerror* "Unexpected token ~A ignored" (format-token lexer))
310 ;; Scan a terminating semicolon.
311 (require-token lexer #\;)
316 ;; Assemble the module and we're done.
317 (make-instance 'module
318 :name (stream-pathname (lexer-stream lexer))
321 :header-fragments hfrags
322 :source-fragments cfrags
323 :dependencies deps))))
325 ;;;----- That's all, folks --------------------------------------------------