Commit | Line | Data |
---|---|---|
dea4d055 MW |
1 | ;;; -*-lisp-*- |
2 | ;;; | |
3 | ;;; Module protocol definition | |
4 | ;;; | |
5 | ;;; (c) 2009 Straylight/Edgeware | |
6 | ;;; | |
7 | ||
8 | ;;;----- Licensing notice --------------------------------------------------- | |
9 | ;;; | |
10 | ;;; This file is part of the Sensble Object Design, an object system for C. | |
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." | |
87 | `(add-clear-the-decks-function ',name (lambda () ,@body))) | |
88 | ||
89 | (export 'clear-the-decks) | |
90 | (defun clear-the-decks () | |
91 | "Invoke a sequence of functions to reset the world." | |
92 | (dolist (item *clear-the-decks-alist*) | |
93 | (funcall (cdr item)))) | |
94 | ||
95 | ;;;-------------------------------------------------------------------------- | |
96 | ;;; Module construction protocol. | |
97 | ||
98 | (export '*module*) | |
99 | (defparameter *module* nil | |
100 | "The current module under construction. | |
101 | ||
bf090e02 MW |
102 | During module construction, this is always an instance of `module'. Once |
103 | we've finished constructing it, we'll call `change-class' to turn it into | |
52a79ab8 | 104 | an instance of whatever type is requested in the module's `:module-class' |
bf090e02 | 105 | property.") |
dea4d055 MW |
106 | |
107 | (export 'module-import) | |
108 | (defgeneric module-import (object) | |
109 | (:documentation | |
110 | "Import definitions into the current environment. | |
111 | ||
112 | Instructs the OBJECT to import its definitions into the current | |
113 | environment. Modules pass the request on to their constituents. There's | |
114 | a default method which does nothing at all. | |
115 | ||
116 | It's not usual to modify the current module. Inserting things into the | |
117 | `*module-type-map*' is a good plan.") | |
1d8cc67a MW |
118 | (:method (object) |
119 | (declare (ignore object)) | |
120 | nil)) | |
dea4d055 MW |
121 | |
122 | (export 'add-to-module) | |
123 | (defgeneric add-to-module (module item) | |
124 | (:documentation | |
125 | "Add ITEM to the MODULE's list of accumulated items. | |
126 | ||
048d0b2d | 127 | The module items participate in the `module-import' and `hook-output' |
dea4d055 MW |
128 | protocols.")) |
129 | ||
130 | (export 'finalize-module) | |
131 | (defgeneric finalize-module (module) | |
132 | (:documentation | |
133 | "Finalizes a module, setting everything which needs setting. | |
134 | ||
135 | This isn't necessary if you made the module by hand. If you've | |
136 | constructed it incrementally, then it might be a good plan. In | |
137 | particular, it will change the class (using `change-class') of the module | |
52a79ab8 MW |
138 | according to the class choice set in the module's `:module-class' |
139 | property. This has the side effects of calling `shared-initialize', | |
140 | setting the module's state to `t', and checking for unrecognized | |
bf090e02 MW |
141 | properties. (Therefore subclasses should add a method to |
142 | `shared-initialize' taking care of looking at interesting properties, just | |
143 | to make sure they're ticked off.)")) | |
dea4d055 MW |
144 | |
145 | ;;;-------------------------------------------------------------------------- | |
146 | ;;; Module objects. | |
147 | ||
148 | (export '(module module-name module-pset module-items module-dependencies)) | |
149 | (defclass module () | |
150 | ((name :initarg :name :type pathname :reader module-name) | |
151 | (pset :initarg :pset :initform (make-pset) :type pset :reader module-pset) | |
152 | (items :initarg :items :initform nil :type list :accessor module-items) | |
153 | (dependencies :initarg :dependencies :initform nil | |
154 | :type list :accessor module-dependencies) | |
9ec578d9 MW |
155 | (variables :initarg :variables :type list :accessor module-variables |
156 | :initform (mapcar (compose #'cdr #'funcall) | |
157 | *module-bindings-alist*)) | |
dea4d055 MW |
158 | (state :initarg :state :initform nil :accessor module-state)) |
159 | (:documentation | |
160 | "A module is a container for the definitions made in a source file. | |
161 | ||
162 | Modules are the fundamental units of translation. The main job of a | |
163 | module is to remember which definitions it contains, so that they can be | |
164 | translated and written to output files. The module contains the following | |
165 | handy bits of information: | |
166 | ||
167 | * A (path) name, which is the filename we used to find it. The default | |
168 | output filenames are derived from this. (We use the file's truename | |
169 | as the hash key to prevent multiple inclusion, and that's a different | |
170 | thing.) | |
171 | ||
172 | * A property list containing other useful things. | |
173 | ||
174 | * A list of items which the module contains. | |
175 | ||
176 | * A list of other modules that this one depends on. | |
177 | ||
9ec578d9 MW |
178 | * A list of module-variable values, in the order in which they're named |
179 | in `*module-bindings-alist*'. | |
180 | ||
dea4d055 MW |
181 | Modules are usually constructed by the `read-module' function, though |
182 | there's nothing to stop fancy extensions building modules | |
183 | programmatically.")) | |
184 | ||
185 | (export 'define-module) | |
186 | (defmacro define-module | |
187 | ((name &key (truename nil truenamep) (location nil locationp)) | |
188 | &body body) | |
bf090e02 | 189 | "Define and return a new module. |
dea4d055 | 190 | |
bf090e02 | 191 | The module will be called NAME; it will be included in the `*module-map*' |
dea4d055 MW |
192 | only if it has a TRUENAME (which defaults to the truename of NAME, or nil |
193 | if there is no file with that name). The module is populated by | |
bf090e02 | 194 | evaluating the BODY in a dynamic environment where `*module*' is bound to |
dea4d055 MW |
195 | the module under construction, and any other module variables are bound to |
196 | appropriate initial values -- see `*module-bindings-alist*' and | |
197 | `define-module-var'. | |
198 | ||
bf090e02 MW |
199 | If a module with the same NAME is already known, then it is returned |
200 | unchanged: the BODY is not evaluated. | |
201 | ||
202 | The LOCATION may be any printable value other than `t' (though | |
203 | `file-location' objects are most usual) indicating what provoked this | |
204 | module definition: it gets reported to the user if an import cycle is | |
205 | detected. This check is made only if a TRUENAME is supplied. | |
206 | ||
dea4d055 MW |
207 | Evaluation order irregularity: the TRUENAME and LOCATION arguments are |
208 | always evaluated in that order, regardless of their order in the macro | |
bf090e02 | 209 | call site (which this macro can't detect)." |
dea4d055 MW |
210 | |
211 | `(build-module ,name | |
212 | (lambda () ,@body) | |
213 | ,@(and truenamep `(:truename ,truename)) | |
214 | ,@(and locationp `(:location ,location)))) | |
215 | ||
239fa5bd MW |
216 | (export 'with-temporary-module) |
217 | (defmacro with-temporary-module ((&key) &body body) | |
218 | "Evaluate BODY within the context of a temporary module." | |
219 | `(call-with-temporary-module (lambda () ,@body))) | |
220 | ||
dea4d055 | 221 | ;;;----- That's all, folks -------------------------------------------------- |