3 ;;; Module protocol definition
5 ;;; (c) 2009 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This file is part of the Sensible Object Design, an object system for C.
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 ;;;--------------------------------------------------------------------------
29 ;;; Module environment.
31 (defvar *module-bindings-alist* nil
32 "An alist of (SYMBOL . THUNK) pairs.
34 During module construction, each SYMBOL is special-bound to the value
35 returned by the corresponding THUNK.")
37 (export 'add-module-binding)
38 (defun add-module-binding (symbol thunk)
39 "Add a new module variable binding.
41 During module construction, SYMBOL will be special-bound to the value
42 returned by THUNK. If you can, use `define-module-var' instead."
43 (aif (assoc symbol *module-bindings-alist*)
45 (asetf *module-bindings-alist* (acons symbol thunk it))))
47 (export 'define-module-var)
48 (defmacro define-module-var (name value-form &optional documentation)
49 "Add a new module variable binding.
51 During module construction, NAME will be special-bound to the value of
52 VALUE-FORM. The NAME is proclaimed special, but is initially left
57 `((setf (documentation ',name 'variable) ,documentation)))
58 (add-module-binding ',name (lambda () ,value-form))))
60 (export 'with-module-environment)
61 (defmacro with-module-environment ((&optional (module '*module*)) &body body)
62 "Evaluate the BODY with MODULE's variable bindings in scope."
63 `(call-with-module-environment (lambda () ,@body) ,module))
65 ;;;--------------------------------------------------------------------------
68 (defvar *clear-the-decks-alist* nil
69 "List tracking functions to be called by `clear-the-decks'.")
71 (export 'add-clear-the-decks-function)
72 (defun add-clear-the-decks-function (symbol thunk)
73 "Add a function to the `clear-the-decks' list.
75 If a function tagged by SYMBOL already exists on the list, then that
76 function is replaced; otherwise a new function is added."
77 (aif (assoc symbol *clear-the-decks-alist*)
79 (asetf *clear-the-decks-alist* (acons symbol thunk it))))
81 (export 'define-clear-the-decks)
82 (defmacro define-clear-the-decks (name &body body)
83 "Add behaviour to `clear-the-decks'.
85 When `clear-the-decks' is called, the BODY will be evaluated as a progn.
86 The relative order of `clear-the-decks' operations is unspecified."
87 (multiple-value-bind (docs decls body) (parse-body body)
88 `(add-clear-the-decks-function ',name (lambda ()
90 (block ,name ,@body)))))
92 (export 'clear-the-decks)
93 (defun clear-the-decks ()
94 "Invoke a sequence of functions to reset the world."
95 (dolist (item *clear-the-decks-alist*)
96 (funcall (cdr item))))
98 ;;;--------------------------------------------------------------------------
99 ;;; Module construction protocol.
102 (defparameter *module* nil
103 "The current module under construction.
105 During module construction, this is always an instance of `module'. Once
106 we've finished constructing it, we'll call `change-class' to turn it into
107 an instance of whatever type is requested in the module's `:module-class'
110 (export 'module-import)
111 (defgeneric module-import (object)
113 "Import definitions into the current environment.
115 Instructs the OBJECT to import its definitions into the current
116 environment. Modules pass the request on to their constituents. There's
117 a default method which does nothing at all.
119 It's not usual to modify the current module. Inserting things into the
120 `*module-type-map*' is a good plan.")
122 (declare (ignore object))
125 (export 'add-to-module)
126 (defgeneric add-to-module (module item)
128 "Add ITEM to the MODULE's list of accumulated items.
130 The module items participate in the `module-import' and `hook-output'
133 (export 'finalize-module)
134 (defgeneric finalize-module (module)
136 "Finalizes a module, setting everything which needs setting.
138 This isn't necessary if you made the module by hand. If you've
139 constructed it incrementally, then it might be a good plan. In
140 particular, it will change the class (using `change-class') of the module
141 according to the class choice set in the module's `:module-class'
142 property. This has the side effects of calling `shared-initialize',
143 setting the module's state to `t', and checking for unrecognized
144 properties. (Therefore subclasses should add a method to `shared-
145 initialize' taking care of looking at interesting properties, just to make
146 sure they're ticked off.)"))
148 ;;;--------------------------------------------------------------------------
151 (export '(module module-name module-pset module-errors
152 module-items module-dependencies module-state))
154 ((name :initarg :name :type pathname :reader module-name)
155 (%pset :initarg :pset :initform (make-pset)
156 :type pset :reader module-pset)
157 (errors :initarg :errors :initform 0 :type fixnum :reader module-errors)
158 (items :initarg :items :initform nil :type list :accessor module-items)
159 (dependencies :initarg :dependencies :initform nil
160 :type list :accessor module-dependencies)
161 (variables :initarg :variables :type list :accessor module-variables
162 :initform (mapcar (compose #'cdr #'funcall)
163 *module-bindings-alist*))
164 (state :initarg :state :initform nil :accessor module-state))
166 "A module is a container for the definitions made in a source file.
168 Modules are the fundamental units of translation. The main job of a
169 module is to remember which definitions it contains, so that they can be
170 translated and written to output files. The module contains the following
171 handy bits of information:
173 * A (path) name, which is the filename we used to find it. The default
174 output filenames are derived from this. (We use the file's truename
175 as the hash key to prevent multiple inclusion, and that's a different
178 * A property list containing other useful things.
180 * A list of items which the module contains.
182 * A list of other modules that this one depends on.
184 * A list of module-variable values, in the order in which they're named
185 in `*module-bindings-alist*'.
187 Modules are usually constructed by the `read-module' function, though
188 there's nothing to stop fancy extensions building modules
191 (export 'define-module)
192 (defmacro define-module
193 ((name &key (truename nil truenamep) (location nil locationp))
195 "Define and return a new module.
197 The module will be called NAME; it will be included in the `*module-map*'
198 only if it has a TRUENAME (which defaults to the truename of NAME, or nil
199 if there is no file with that name). The module is populated by
200 evaluating the BODY in a dynamic environment where `*module*' is bound to
201 the module under construction, and any other module variables are bound to
202 appropriate initial values -- see `*module-bindings-alist*' and
205 If a module with the same NAME is already known, then it is returned
206 unchanged: the BODY is not evaluated.
208 The LOCATION may be any printable value other than `t' (though
209 `file-location' objects are most usual) indicating what provoked this
210 module definition: it gets reported to the user if an import cycle is
211 detected. This check is made only if a TRUENAME is supplied.
213 Evaluation order irregularity: the TRUENAME and LOCATION arguments are
214 always evaluated in that order, regardless of their order in the macro
215 call site (which this macro can't detect)."
219 ,@(and truenamep `(:truename ,truename))
220 ,@(and locationp `(:location ,location))))
222 (export 'with-temporary-module)
223 (defmacro with-temporary-module ((&key) &body body)
224 "Evaluate BODY within the context of a temporary module."
225 `(call-with-temporary-module (lambda () ,@body)))
227 ;;;--------------------------------------------------------------------------
230 (export '(c-fragment c-fragment-text))
231 (defclass c-fragment ()
232 ((location :initarg :location :type file-location :reader file-location)
233 (text :initarg :text :type string :reader c-fragment-text))
235 "Represents a fragment of C code to be written to an output file.
237 A C fragment is aware of its original location, and will bear proper
238 `#line' markers when written out."))
240 ;;;----- That's all, folks --------------------------------------------------