Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Module protocol definition | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
e0808c47 | 10 | ;;; This file is part of the Sensible Object Design, an object system for C. |
dea4d055 MW |
11 | ;;; |
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. | |
16 | ;;; | |
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. | |
21 | ;;; | |
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. | |
25 | ||
26 | (cl:in-package #:sod) | |
27 | ||
28 | ;;;-------------------------------------------------------------------------- | |
29 | ;;; Module environment. | |
30 | ||
31 | (defvar *module-bindings-alist* nil | |
32 | "An alist of (SYMBOL . THUNK) pairs. | |
33 | ||
34 | During module construction, each SYMBOL is special-bound to the value | |
35 | returned by the corresponding THUNK.") | |
36 | ||
37 | (export 'add-module-binding) | |
38 | (defun add-module-binding (symbol thunk) | |
39 | "Add a new module variable binding. | |
40 | ||
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*) | |
44 | (setf (cdr it) thunk) | |
45 | (asetf *module-bindings-alist* (acons symbol thunk it)))) | |
46 | ||
47 | (export 'define-module-var) | |
48 | (defmacro define-module-var (name value-form &optional documentation) | |
49 | "Add a new module variable binding. | |
50 | ||
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 | |
53 | unbound." | |
54 | `(progn | |
55 | (defvar ,name) | |
56 | ,@(and documentation | |
57 | `((setf (documentation ',name 'variable) ,documentation))) | |
58 | (add-module-binding ',name (lambda () ,value-form)))) | |
59 | ||
9ec578d9 MW |
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)) | |
dea4d055 MW |
64 | |
65 | ;;;-------------------------------------------------------------------------- | |
66 | ;;; The reset switch. | |
67 | ||
68 | (defvar *clear-the-decks-alist* nil | |
69 | "List tracking functions to be called by `clear-the-decks'.") | |
70 | ||
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. | |
74 | ||
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*) | |
78 | (setf (cdr it) thunk) | |
79 | (asetf *clear-the-decks-alist* (acons symbol thunk it)))) | |
80 | ||
81 | (export 'define-clear-the-decks) | |
82 | (defmacro define-clear-the-decks (name &body body) | |
83 | "Add behaviour to `clear-the-decks'. | |
84 | ||
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." | |
fc09e191 MW |
87 | (multiple-value-bind (docs decls body) (parse-body body) |
88 | `(add-clear-the-decks-function ',name (lambda () | |
89 | ,@docs ,@decls | |
90 | (block ,name ,@body))))) | |
dea4d055 MW |
91 | |
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)))) | |
97 | ||
98 | ;;;-------------------------------------------------------------------------- | |
99 | ;;; Module construction protocol. | |
100 | ||
101 | (export '*module*) | |
102 | (defparameter *module* nil | |
103 | "The current module under construction. | |
104 | ||
bf090e02 MW |
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 | |
52a79ab8 | 107 | an instance of whatever type is requested in the module's `:module-class' |
bf090e02 | 108 | property.") |
dea4d055 MW |
109 | |
110 | (export 'module-import) | |
111 | (defgeneric module-import (object) | |
112 | (:documentation | |
113 | "Import definitions into the current environment. | |
114 | ||
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. | |
118 | ||
119 | It's not usual to modify the current module. Inserting things into the | |
120 | `*module-type-map*' is a good plan.") | |
1d8cc67a MW |
121 | (:method (object) |
122 | (declare (ignore object)) | |
123 | nil)) | |
dea4d055 MW |
124 | |
125 | (export 'add-to-module) | |
126 | (defgeneric add-to-module (module item) | |
127 | (:documentation | |
128 | "Add ITEM to the MODULE's list of accumulated items. | |
129 | ||
048d0b2d | 130 | The module items participate in the `module-import' and `hook-output' |
dea4d055 MW |
131 | protocols.")) |
132 | ||
133 | (export 'finalize-module) | |
134 | (defgeneric finalize-module (module) | |
135 | (:documentation | |
136 | "Finalizes a module, setting everything which needs setting. | |
137 | ||
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 | |
52a79ab8 MW |
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 | |
3400f60f MW |
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.)")) | |
dea4d055 MW |
147 | |
148 | ;;;-------------------------------------------------------------------------- | |
149 | ;;; Module objects. | |
150 | ||
287e744e | 151 | (export '(module module-name module-pset module-errors |
e05aabbb | 152 | module-items module-files module-dependencies module-state)) |
dea4d055 MW |
153 | (defclass module () |
154 | ((name :initarg :name :type pathname :reader module-name) | |
4b8e5c03 MW |
155 | (%pset :initarg :pset :initform (make-pset) |
156 | :type pset :reader module-pset) | |
287e744e | 157 | (errors :initarg :errors :initform 0 :type fixnum :reader module-errors) |
dea4d055 | 158 | (items :initarg :items :initform nil :type list :accessor module-items) |
e05aabbb | 159 | (files :initarg :files :initform nil :type list :accessor module-files) |
dea4d055 MW |
160 | (dependencies :initarg :dependencies :initform nil |
161 | :type list :accessor module-dependencies) | |
9ec578d9 MW |
162 | (variables :initarg :variables :type list :accessor module-variables |
163 | :initform (mapcar (compose #'cdr #'funcall) | |
164 | *module-bindings-alist*)) | |
dea4d055 MW |
165 | (state :initarg :state :initform nil :accessor module-state)) |
166 | (:documentation | |
167 | "A module is a container for the definitions made in a source file. | |
168 | ||
169 | Modules are the fundamental units of translation. The main job of a | |
170 | module is to remember which definitions it contains, so that they can be | |
171 | translated and written to output files. The module contains the following | |
172 | handy bits of information: | |
173 | ||
174 | * A (path) name, which is the filename we used to find it. The default | |
175 | output filenames are derived from this. (We use the file's truename | |
176 | as the hash key to prevent multiple inclusion, and that's a different | |
177 | thing.) | |
178 | ||
179 | * A property list containing other useful things. | |
180 | ||
181 | * A list of items which the module contains. | |
182 | ||
183 | * A list of other modules that this one depends on. | |
184 | ||
e05aabbb MW |
185 | * A list of other files this module has read. |
186 | ||
9ec578d9 MW |
187 | * A list of module-variable values, in the order in which they're named |
188 | in `*module-bindings-alist*'. | |
189 | ||
dea4d055 MW |
190 | Modules are usually constructed by the `read-module' function, though |
191 | there's nothing to stop fancy extensions building modules | |
192 | programmatically.")) | |
193 | ||
194 | (export 'define-module) | |
195 | (defmacro define-module | |
196 | ((name &key (truename nil truenamep) (location nil locationp)) | |
197 | &body body) | |
bf090e02 | 198 | "Define and return a new module. |
dea4d055 | 199 | |
bf090e02 | 200 | The module will be called NAME; it will be included in the `*module-map*' |
dea4d055 MW |
201 | only if it has a TRUENAME (which defaults to the truename of NAME, or nil |
202 | if there is no file with that name). The module is populated by | |
bf090e02 | 203 | evaluating the BODY in a dynamic environment where `*module*' is bound to |
dea4d055 MW |
204 | the module under construction, and any other module variables are bound to |
205 | appropriate initial values -- see `*module-bindings-alist*' and | |
206 | `define-module-var'. | |
207 | ||
bf090e02 MW |
208 | If a module with the same NAME is already known, then it is returned |
209 | unchanged: the BODY is not evaluated. | |
210 | ||
211 | The LOCATION may be any printable value other than `t' (though | |
212 | `file-location' objects are most usual) indicating what provoked this | |
213 | module definition: it gets reported to the user if an import cycle is | |
214 | detected. This check is made only if a TRUENAME is supplied. | |
215 | ||
dea4d055 MW |
216 | Evaluation order irregularity: the TRUENAME and LOCATION arguments are |
217 | always evaluated in that order, regardless of their order in the macro | |
bf090e02 | 218 | call site (which this macro can't detect)." |
dea4d055 MW |
219 | |
220 | `(build-module ,name | |
221 | (lambda () ,@body) | |
222 | ,@(and truenamep `(:truename ,truename)) | |
223 | ,@(and locationp `(:location ,location)))) | |
224 | ||
239fa5bd MW |
225 | (export 'with-temporary-module) |
226 | (defmacro with-temporary-module ((&key) &body body) | |
227 | "Evaluate BODY within the context of a temporary module." | |
228 | `(call-with-temporary-module (lambda () ,@body))) | |
229 | ||
6c3c2dd3 MW |
230 | ;;;-------------------------------------------------------------------------- |
231 | ;;; Code fragments. | |
232 | ||
233 | (export '(c-fragment c-fragment-text)) | |
234 | (defclass c-fragment () | |
235 | ((location :initarg :location :type file-location :reader file-location) | |
236 | (text :initarg :text :type string :reader c-fragment-text)) | |
237 | (:documentation | |
238 | "Represents a fragment of C code to be written to an output file. | |
239 | ||
240 | A C fragment is aware of its original location, and will bear proper | |
241 | `#line' markers when written out.")) | |
242 | ||
dea4d055 | 243 | ;;;----- That's all, folks -------------------------------------------------- |